在 visio 中打开文件对话框 vba
open a fileDialog in visio vba
我正在 vba Word 和 visio 2013 中编写宏代码。我想打开一个文件对话框,以便用户可以选择保存文件的位置。
我在 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 中做同样的事情吗?
虽然说Visio有Application.FileDialog
,但在VisioVBA中会失败。
但是,作为 解决方法,您可以通过 Excel、Word 或其他 Office 应用程序 访问 FileDialog 对象。下面的代码使用 Word 来完成,因为您同时使用了两者。
这是一个 函数,它将 return 一个包含所选文件的所有路径的数组 :
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
如果您不想使用其他办公应用程序,您可以使用 winapi OpenFileDialog
来实现类似的行为,但它不会像 .FileDialog
.[=14= 那样简单]
在此处查看更多详细信息:
Open File Dialog in Visio
模块源码(兼容Visio 2010及以上版本,即兼容x64版本)。原源码,兼容之前的版本,查看上面link.
'// 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
我正在 vba Word 和 visio 2013 中编写宏代码。我想打开一个文件对话框,以便用户可以选择保存文件的位置。
我在 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 中做同样的事情吗?
虽然说Visio有Application.FileDialog
,但在VisioVBA中会失败。
但是,作为 解决方法,您可以通过 Excel、Word 或其他 Office 应用程序 访问 FileDialog 对象。下面的代码使用 Word 来完成,因为您同时使用了两者。
这是一个 函数,它将 return 一个包含所选文件的所有路径的数组 :
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
如果您不想使用其他办公应用程序,您可以使用 winapi OpenFileDialog
来实现类似的行为,但它不会像 .FileDialog
.[=14= 那样简单]
在此处查看更多详细信息: Open File Dialog in Visio
模块源码(兼容Visio 2010及以上版本,即兼容x64版本)。原源码,兼容之前的版本,查看上面link.
'// 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