如何使用 Word 中的命令按钮创建另存为弹出窗口？

Question

我的代码允许用户输入数据（姓名、地址、公司名称、城市、州），效果很好，当用户点击提交时，它会将其填充到 word 文档中。

接下来，如果可能的话，我还尝试在单击提交后立即显示保存为弹出窗口，但不知道下一步该做什么。我尝试了多个示例，但是所有示例都给了我预期的编译错误 end sub 我需要帮助！！

这是我的工作代码：

Private Sub CommandButton1_Click()
    Dim firstnamelastname As Range
    Set firstnamelastname = ActiveDocument.Bookmarks("firstnamelastname").Range
    firstnamelastname.Text = Me.TextBox1.Value
    Dim Companyname As Range
    Set Companyname = ActiveDocument.Bookmarks("Companyname").Range
    Companyname.Text = Me.TextBox2
    Dim Address As Range
    Set Address = ActiveDocument.Bookmarks("address").Range
    Address.Text = Me.TextBox3
    Dim citystatezip As Range
    Set citystatezip = ActiveDocument.Bookmarks("Citystatezip").Range
    citystatezip.Text = Me.TextBox4
    Me.Repaint
    userform1.hide

但是当我添加任何保存时，它不起作用。

我也可以删除 userform1.hide 代码并添加另一个保存按钮；然后userform.hide，这样他们就可以继续写文档了。

Answer 1

无需使用 Windows API。

Application.Dialogs 属性返回一个 Dialogs 集合，该集合代表 Word 中的所有内置对话框。要从集合中获取对象，您需要传递WdWordDialog enumeration 的实例。例如，以下代码显示了带有预定义值的 SaveAs 对话框：

dim strFullPath as string
dim strRootPath as string
dim strFileName as string

strRootPath = "C:\Users\Eugene\Documents\"
strFileName = "FileName.docx"
strFullPath = strRootPath & strFileName

With appWrd.Dialogs(wdDialogFileSaveAs)
    .Name = strFullPath
    .Format = Word.WdSaveFormat.wdFormatXMLDocument
    .Show
End With

Answer 2

以下代码显示了一个带有预设过滤器的“另存为”对话框。如果未取消，则返回保存文件的完整路径。
此代码适用于 32 位 Office。对于 64 位 Office，必须更改声明。

在任何 Subs 或 Functions 之前放置以下声明：

'Declarations for GetSaveAsFile
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ByRef pOpenfilename As OPENFILENAME) As Long
Private Const OFN_EXPLORER As Long = &H80000
Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

此函数显示对话框并返回完整路径：

Public Function GetSaveAsFile(Optional ByVal HWnd As Long = 0, Optional ByVal strPath As String, _
   Optional ByVal arrFilters As Variant, Optional ByRef lngFilterIndex As Long = -1, Optional ByVal strTitle As String = "") As String
  '00-01s Prompts for a file name using a SaveAs dialog
  'Returns full path; returns "" if canceled
  'Saves to default location if no path specified
  '"All Files" if no filters specified; no filter if arrFilters = ""
  'lngFilterIndex: 0-based index for selected filter (in and out); -1 if canceled
  'strTitle = "": "Save as" localized
  On Error GoTo ErrHand
  Dim typOFName As OPENFILENAME
  Const lngMAX_FILE As Long = 500           'buffer size
  Dim strFile As String                     'file name
  Dim strFilters As String                  'filters string
  Dim i As Long

  strFile = Mid$(strPath, InStrRev(strPath, "\") + 1) 'crop preset file name/pattern from path
  If IsMissing(arrFilters) Or IsEmpty(arrFilters) Then               'default: All files (*.*)
    strFilters = "All files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
  ElseIf VarType(arrFilters) = vbString Then 'no filter
  Else                                      'compose filter string
    For i = 0 To UBound(arrFilters, 1)
      strFilters = strFilters & arrFilters(i, 0) & " (*." & arrFilters(i, 1) & ")" & vbNullChar & "*." & arrFilters(i, 1) & vbNullChar
    Next i
  End If
  strFilters = strFilters & vbNullChar      'append second vbNullChar
                                            'prepare structure
  With typOFName
    .lStructSize = Len(typOFName)
    .hwndOwner = HWnd                       'parent window
    .lpstrFilter = strFilters               'file filters
    .nFilterIndex = lngFilterIndex + 1      'preset filter index
    .lpstrFile = strFile & Space$(lngMAX_FILE - Len(strFile) - 2) 'create buffer and preset file name
    .nMaxFile = lngMAX_FILE                 'maximum length of a returned file
    .lpstrInitialDir = strPath              'initial path
    .lpstrTitle = strTitle                  'dialog title
    .flags = OFN_EXPLORER                   'show explorer style dialog
    .lpstrDefExt = ""                       'enables default extension according to selected filter
    If GetSaveFileName(typOFName) Then      'call dialog
      GetSaveAsFile = Left$(.lpstrFile, InStr(1, .lpstrFile, vbNullChar) - 1) 'cut before NullChar
      lngFilterIndex = .nFilterIndex - 1    'read filter index
    Else
      lngFilterIndex = -1
    End If
  End With

Exit Function
ErrHand: 'your error handler
End Function

参数说明：

'HWnd：调用该函数的窗口的窗口句柄，例如您的 Word 窗口； ActiveWindow.HWnd。或者您可以传递0.
'strPath：使用此路径打开“另存为”对话框
'arrFilter：基于 0 的二维数组，具有一个或多个过滤器名称和文件扩展名；或 "" 表示所有文件 。
'lngFilterIndex：如果您传递具有多个过滤器定义的数组，则为 0 或更高。
'strTitle：如果您喜欢特别的一个

您调用该函数将文档保存为 docx，如下所示：

'Example to call the function:
Sub SaveDoc()

  Dim arrFilters As Variant                 '0-based 2-dim. array with filter types and extensions
  Dim strFullPath As String                 'resulting full path from dialog
  Dim lngFormat As Word.WdSaveFormat        'format to save document
    
  ReDim arrFilters(0 To 0, 0 To 1)          'prepare array for 1 filter
  arrFilters(0, 0) = "Word Document"        'filter file type
  arrFilters(0, 1) = "docx"                 'filter extension
  lngFormat = wdFormatXMLDocument 'docx format (change if you prefer another format)
  
  strFullPath = GetSaveAsFile(HWnd:=ActiveWindow.HWnd, strPath:=ActiveDocument.Path & "\", _
      arrFilters:=arrFilters, lngFilterIndex:=0, strTitle:="")
  If Len(strFullPath) > 0 Then              'skip if dialog canceled
    ActiveDocument.SaveAs2 strFullPath, lngFormat 'save active document (see reference of SaveAs2 for more parameters)
  End If

End Sub