我有VBA代码,可控制用户以.xls,.xlsm或.pdf以外的其他格式保存文件。这是为了防止在保存过程中剥离宏。
我已插入一行以检查操作系统是否为OSx(...类似于“ Mac”),该操作系统可在其他宏中使用,但不适用于此宏。该过程失败,并突出显示“ msoFileDialogSaveAs”,显示“无法找到文件对象或库”。
这是我的代码:
Option Explicit
Option Compare Text
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Dim fso As Object 'FileSystemObject
Dim PdfSave As Boolean
Dim SheetName As String
If Not Application.OperatingSystem Like "*Mac*" Then
SheetName = ActiveSheet.Name
'Save-As action?
If SaveAsUI Then
Set fso = CreateObject("Scripting.FileSystemObject")
'Abort excel's dialog
Cancel = True
'Create our own
With Application.FileDialog(msoFileDialogSaveAs)
'Select the XLSM filter by default
.FilterIndex = 2
Again:
'Ok clicked?
If .Show = -1 Then
'Which extension should we save?
Select Case fso.GetExtensionName(.SelectedItems(1))
Case "xlsm"
'Okay
Case "xls"
'Okay
Case "pdf"
PdfSave = True
'Okay
Case Else
MsgBox "Invalid file type selected!" _
& vbCr & vbCr & "Only the following file formats are permitted:" _
& vbCr & " 1. Excel Macro-Enabled Workbook (*.xlsm)" _
& vbCr & " 2. Excel 97-2003 Workbook (*.xls)" _
& vbCr & " 3. PDF (*.pdf)" _
& vbCr & vbCr & "Please try again." _
& vbCr & vbCr & "NOTE: 'Excel 97-2003 Workbook (*.xls)' format should be used for" _
& vbCr & "backwards compatability only!", vbOKOnly + vbCritical
GoTo Again
End Select
'Prevent that we call ourself
Application.EnableEvents = False
'Save the file
If PdfSave = True Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & SheetName & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
ThisWorkbook.SaveAs .SelectedItems(1)
End If
Application.EnableEvents = True
End If
End With
End If
End If
End Sub
任何人都可以提出更改建议,以使此代码在PC和MAC上都适用于Office,或者具有实现相同功能的不同代码。
谢谢
麦克风
最佳答案
在Mac和PC环境中工作时,您要走出地图的边缘,我必须做很多事情,而且波涛汹涌的大海一定可以!我的建议是坚持不变的,您的方向正确。
首先,我有一个类似的OS检查:-
BlnIsAPC = IIf(Left(Trim(UCase(Application.OperatingSystem)), 1) = "M", False, True)
这只是试图以最可靠的方式来正确安装操作系统。
其次,最好延迟绑定到
Scripting.FileSystemObject
,因为这在Mac Office中是不存在的(它是Windows的一部分而不是Office)。第三,
FileDialog
都不是,因此出现错误“找不到文件对象或库”。有一种替代方法,您最终将需要对其进行相当多的引用。它是一个称为MacScript的内置函数。您将需要弄清楚如何在AppleScript中进行操作,然后创建该脚本并通过VBA中的MacScript运行它。以下是我的工作的简化示例,其中我的代码在PC上使用
Application.FileDialog(msoFileDialogOpen)
或在Mac上使用MacScript
,特别是这仅显示了Mac方面。Public Function GetFilePath(ByVal StrTitle As String, ByVal StrButtonName As String, ByVal BlnMultiSelect As Boolean, ByVal StrFilters As String) As String
' StrTitle = The title to go on the dialog box
' StrButtonName = What to show on the OK button
' BlnMultiSelect = Can the user select more than one file
' StrFilters = What can be selected pipe and colon delimited i.e. [name]:[suffix]|[name]:[suffix]
If Procs.Global_IsAPC Then
GetFilePath = GetFilePath_PC(StrTitle, StrButtonName, BlnMultiSelect, StrFilters)
Else
GetFilePath = GetFilePath_Mac(StrTitle, StrButtonName, BlnMultiSelect, StrFilters)
End If
End Function
Private Function GetFilePath_PC(ByVal StrTitle As String, ByVal StrButtonName As String, ByVal BlnMultiSelect As Boolean, StrFilters As String) As String
...
End Function
Private Function GetFilePath_Mac(ByVal StrTitle As String, ByVal StrButtonName As String, ByVal BlnMultiSelect As Boolean, StrFilters As String) As String
Dim AryTemp2() As String
Dim LngCounter As Long
Dim StrContainer As String
Dim StrPath As String
StrContainer = "tell application " & """" & "Finder" & """" & Chr(13)
StrContainer = StrContainer & "choose file with prompt " & """" & StrTitle & """"
If StrFilters <> "" Then
StrContainer = StrContainer & " of type {"
'Code was here that prepared the filters into AryTemp2
For LngCounter = 0 To UBound(AryTemp2, 1)
If Right(StrContainer, 1) <> "{" Then StrContainer = StrContainer & ", "
StrContainer = StrContainer & """" & AryTemp2(LngCounter2) & """"
Next
StrContainer = StrContainer & "} "
End If
StrContainer = StrContainer & "without invisibles" & IIf(BlnMultiSelect, "", " and multiple selections") & " allowed" & Chr(13)
StrContainer = StrContainer & "end tell"
StrPath = MacScript(StrContainer)
If Left(StrPath, 6) = "alias " Then StrPath = Right(StrPath, Len(StrPath) - 6)
GetFilePath_Mac = StrPath
End Function
仅供参考,
MacScript
,StrContainer
中的执行点如下:-tell application "Finder"
choose file with prompt "Select the required Config stub" of type {"Config_Stub"} without invisibles and multiple selections allowed
end tell
最后,VBA并非在Office for Mac的所有版本上都可用,并且它们之间的工作方式之间存在细微的差异,不幸的是,您只能通过经验来找到它们。就像我说的那样,“您正在离开地图的边缘”进入未知的水域。