SaveAsfunction在Microsoft PC上工作,但不在MAC上

我有VBA代码,控制用户保存除.xls,.xlsm或.pdf以外的任何其他格式的文件。 这是为了防止在保存过程中剥离macros。

我已经插入一行来检查操作系统是否是在其他macros中工作的OSx(…就像“ Mac ”),但不是这个。 该过程失败,“可以find文件对象或库”与“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 

任何人都可以build议更改,以便此代码在PC和MAC上的Office上工作,或有不同的代码实现相同的事情。

谢谢

麦克风

在Mac和PC环境下工作时,你正在走出地图的边缘,我必须做很多事情,它的波涛汹涌的大海肯定是这样的! 我的build议是坚持不懈的,你走在正确的轨道上。

首先,我有一个类似的操作系统检查:

 BlnIsAPC = IIf(Left(Trim(UCase(Application.OperatingSystem)), 1) = "M", False, True) 

这只是试图获得最好的未来certificate的方式来获得操作系统的权利。

其次,对于不在Mac Office(它是Windows不是Office的一部分)的Scripting.FileSystemObject ,它迟到了。

第三,既不是FileDialog ,因此错误“ 无法find文件对象或库 ”。 有一个select,你会最终需要参考一下公平的一点。 它是一个名为MacScript的内置函数。

您将需要制定如何在AppleScript中执行此操作,然后创build该脚本并通过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 ie [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执行的FYI, 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不适用于所有版本的Mac版本,并且在它们之间的工作方式有细微的差别,不幸的是,您只能通过经验find。 就像我说' 你正在离开地图的边缘 '进入未知的水域。