Question

我有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，或者使用不同的代码实现相同的操作。

由于

麦克

Answer 1

当你在Mac和PC环境中工作时，你正走出地图的边缘，我必须做很多事情，它的波涛汹涌的海洋肯定是！我的建议是坚持，你走在正确的轨道上。

首先，我有类似的操作系统检查： -

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

这只是试图获得最适合未来的操作系统。

其次，你很晚就绑定到Scripting.FileSystemObject，因为它不在Mac Office中（它不是Windows的一部分）。

第三，两者都不是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执行点的FYI如下所示： -

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，并且它们之间的工作方式存在细微差别，不幸的是，您只能通过经验来找到它们。就像我说'你正在离开地图的边缘'进入未知的水域。

SaveAs功能适用于Microsoft PC但不适用于MAC

1 个答案: