在 visio vba 中打开一个文件对话框

Question

我在 vba Word 和 visio 2013 中编写宏。我想打开一个 fileDialog，以便用户可以选择保存文件的位置。

我在 word 中成功了，但在 visio 中它的工作方式不同。

我是用word写的：

Dim dlg As FileDialog
Dim strPath As String

'Boite de dialogue pour choisir où enregistrer son fichier
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

With dlg
    .InitialFileName = Application.ActiveDocument.Path
    .AllowMultiSelect = False
    .Title = "Choisir le répertoire d'enregistrement"
    .Show
End With

strPath = dlg.SelectedItems(1)

但它在 visio 中不起作用。有人可以帮我在 visio 中做同样的事情吗？

Answer 1

如果你不想使用其他办公应用，可以使用winapiOpenFileDialog实现类似的行为，但没有.FileDialog那么容易。

在此处查看更多详细信息： Open File Dialog in Visio

模块源代码（与 Visio 2010 及更高版本兼容，即与具有 x64 版本的版本兼容）。原始源代码，兼容以前的版本，请查看上面的链接。

'// This is code that uses the Windows API to invoke the Open File
'// common dialog. It is used by users to choose a file

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As LongPtr
  hInstance As LongPtr
  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 LongPtr
  lpTemplateName As String
End Type

Public Sub OpenFile(ByRef filePath As String, _
                         ByRef cancelled As Boolean)

    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String

    ' On Error GoTo errTrap

    OpenFile.lStructSize = LenB(OpenFile)

    '// Sample filter:
    '// "Text Files (*.txt)" & Chr$(0) & "*.sky" & Chr$(0) & "All Files (*.*)" & Chr$(0) & "*.*"
    sFilter = "All Files (*.*)" & Chr(0) & "*.*"

    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = ThisDocument.Path

    OpenFile.lpstrTitle = "Find Excel Data Source"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)

    If lReturn = 0 Then
       cancelled = True
       filePath = vbNullString
    Else
      cancelled = False
      filePath = Trim(OpenFile.lpstrFile)
      filePath = Replace(filePath, Chr(0), vbNullString)
    End If

    Exit Sub

errTrap:
    Exit Sub
    Resume

End Sub

Answer 2

虽然它说 Visio 有 Application.FileDialog，但它在 Visio VBA 中会失败。

但是，作为一种解决方法，您可以通过 Excel、Word 或其他 Office 应用程序访问 FileDialog 对象。下面的代码使用 Word 执行此操作，就像您同时使用两者一样。

这是一个函数，它将返回一个包含所选文件中所有路径的数组：

Public Function Get_File_via_FileDialog() As Variant
    'fd will be a FileDialog object
    Dim fd As Object
    'Array of pathes
    Dim A()
    ReDim A(0)

    'Create an Word object. You can access the FileDialog object through it.
    Dim WordApp As Object
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number > 0 Then Set WordApp = CreateObject("Word.Application")
    On Error GoTo 0

    WordApp.Visible = True   'This statement necessary so you can see the FileDialog.

    'Declare a variable to contain the path
    'of each selected item. Even though the path is aString,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant

    'Create a FileDialog object as a File Picker dialog box.
    Set fd = WordApp.FileDialog(msoFileDialogFilePicker)

    'Use a With...End With block to reference the FileDialog object.
    With fd
            'Use the Show method to display the File Picker dialog box and return the user's action.
            'The user pressed the button.
        If .Show = -1 Then
            WordApp.Visible = False  'Hide the Excel application

                'Step through each string in the FileDialogSelectedItems collection.
                For Each vrtSelectedItem In .SelectedItems

                    'vrtSelectedItem is a string that contains the path of each selected item.
                    'You can use any file I/O functions that you want to work with this path.
                    'This example displays the path in a message box.
                    A(UBound(A)) = vrtSelectedItem
                    ReDim Preserve A(UBound(A) + 1)
                Next vrtSelectedItem
            'The user pressed Cancel.
        End If
    End With

    'Set the object variable to nothing.
    ReDim Preserve A(UBound(A) - 1)

    Set fd = Nothing
    Set xl = Nothing
Get_File_via_FileDialog = A
End Function