SaveAs功能适用于Microsoft PC，但不适用于MAC [英] SaveAs function works on Microsoft PC but not on MAC

问题描述

我有VBA代码控制用户保存的文件格式不同于.xls，.xlsm或.pdf格式。这是为了防止在保存过程中剥离宏。

我已经插入一行来检查操作系统是否是OSx（...像 Mac ），在其他宏而不是这个宏。该进程失败，并突出显示msoFileDialogSaveAs的Can; t找到文件对象或库。

这是我的代码：

  Option Explicit 
选项比较文本
 
 Private Sub Workbook_BeforeSave（ByVal SaveAsUI As Boolean，_ 
 Cancel As Boolean） 
 
 Dim fso As Object'FileSystemObject 
 Dim PdfSave As Boolean 
 Dim SheetName As String 
如果不是Application.OperatingSystem像* Mac *那么
 SheetName = ActiveSheet.Name 
'另存为动作？ 
如果SaveAsUI然后
设置fso = CreateObject（Scripting.FileSystemObject）
'Abort excel的对话框
取消= True 
'创建我们自己的
与Application.FileDialog（msoFileDialogSaveAs）
'默认选择XLSM过滤器
 .FilterIndex = 2 
再次：
'Ok clicked？ 
如果.Show = -1然后
'我们应该保存哪个扩展名？ 
选择案例fso.GetExtensionName（.SelectedItems（1））
案例xlsm
'好的
案例xls
'好的
案例 pdf
 PdfSave = True 
'Okay 
案例Else 
 MsgBox选择无效的文件类型！ _ 
& vbCr& vbCr& 只允许以下文件格式：_ 
& vbCr& 1. Excel宏启用工作簿（* .xlsm）_ 
& vbCr& 2. Excel 97-2003工作簿（* .xls）_ 
& vbCr& 3. PDF（* .pdf）_ 
& vbCr& vbCr& 请再试一次。 _ 
& vbCr& vbCr& 注意：Excel 97-2003工作簿（* .xls）格式应用于_ 
& vbCr& backwards compatibleability only！，vbOKOnly + vbCritical 
 GoTo Again 
结束选择
'防止我们称之为
 Application.EnableEvents = False 
'保存文件
如果PdfSave = True然后
 ActiveSheet.ExportAsFixedFormat类型：= xlTypePDF，文件名：= ActiveWorkbook.Path& \& SheetName& .pdf，质量：= 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，或者具有不同的代码实现相同的事情。

谢谢

Mike

解决方案

你在Mac和PC环境中工作的时候，我们都会偏离地图的边缘，我必须要做很多，而且它的波涛汹涌的海洋肯定是！我的建议是持续的，你在正确的轨道上。

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

  BlnIsAPC = IIf（Left（Trim（UCase（Application.OperatingSystem）），1）=M，False，True）
  / pre> 
 
 
这只是试图让最有希望获得操作系统的方式。
 
 
 
其次，因为它不在Mac Office（它的Windows不是Office的一部分）。
 
 
 
第三，既不是 FileDialog ，因此错误'找不到文件对象或库'。有一个替代方案，你最终需要把它参考一下。它的一个内置函数叫做 MacScript <一>。 
 
 
 
您将需要了解如何在AppleScript中执行此操作，然后创建该脚本并通过VBA中的MacScript进行运行。以下是我的工作的一个剥离的例子，其中我有一个代码，在PC上使用 Application.FileDialog（msoFileDialogOpen）或 MacScript 在Mac上，具体来说这只是显示Mac端。
 公共函数GetFilePath（ByVal StrTitle As String， ByVal StrButtonName As String，ByVal BlnMultiSelect As Boolean，ByVal StrFilters As String）As String 
'StrTitle =要在对话框上的标题
'StrButtonName =在OK按钮上显示的内容
 'BlnMultiSelect =用户可以选择多个文件
'StrFilters =可以选择管和冒号分隔ie [name]：[后缀] | [名称]：[后缀] 
 
如果Procs.Global_IsAPC然后
 GetFilePath = GetFilePath_PC（StrTitle，StrButtonName，BlnMultiSelect，StrFilters）
 Else 
 GetFilePath = GetFilePath_Mac（StrTitle，StrButtonName，BlnMultiSelect，StrFilters）
 E如果
 
结束函数
 
专用函数GetFilePath_PC（ByVal StrTitle As String，ByVal StrButtonName As String，ByVal BlnMultiSelect As Boolean，StrFilters As String）As String 
。 .. 
结束函数
 
私有函数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& 选择文件提示& & StrTitle& 
 
如果StrFilters<> 然后
 StrContainer = StrContainer& 
'的代码在这里准备过滤器到AryTemp2 
对于LngCounter = 0到UBound（AryTemp2,1）
如果Right（StrContainer，1）<> {Then StrContainer = StrContainer& ，
 StrContainer = StrContainer& & AryTemp2（LngCounter2）& 
 Next 
 StrContainer = StrContainer& }
 End If 
 
 StrContainer = StrContainer& 无隐形& IIf（BlnMultiSelect，，和多个选择）& 允许& Chr（13）
 StrContainer = StrContainer& end tell
 StrPath = MacScript（StrContainer）
 
如果Left（StrPath，6）=aliasThen StrPath = Right（StrPath，Len（StrPath） -  6）
 
 GetFilePath_Mac = StrPath 
 
结束功能
  
 FYI at point执行在 MacScript ， StrContainer 如下所示： -  
 告诉应用程序Finder
选择文件提示选择所需的配置存根类型为{Config_Stub}，不带隐形，允许多个选项
 end tell 
  
最后，VBA不适用于所有版本的Office for Mac，并且有微妙的差异在他们之间工作，不幸的是你只会通过经验来找到。就像我说'你正在离开地图的边缘'进入未知的水域。
 
I have VBA code that controls the user from saving the file in any other format than .xls, .xlsm or .pdf. This is to prevent the stripping out of macros during the save process.

I have inserted a line to check if the operating system is OSx (... Like "Mac") which works in other macros but not this one. The process fails with "Can;t find the file object or library" with 'msoFileDialogSaveAs' highlighted.

Here is my code:
    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
Can anyone suggest changes so that this code works for Office on both PC and MAC, or have different code that achieves the same thing.

Thanks

Mike
解决方案
You're heading off the edge of the map when working in Mac and PC environments, I have to do it a lot and its choppy seas thats for sure! My advice is persist, you are on the right track.

Firstly, I have a similar OS check: -
BlnIsAPC = IIf(Left(Trim(UCase(Application.OperatingSystem)), 1) = "M", False, True)
This is simply trying to have the most future proofed way of getting the OS right.

Secondly, it's good you're late binding to Scripting.FileSystemObject as that is not in Mac Office (Its part of Windows not Office).

Thirdly, neither is FileDialog, hence the error 'Can't find the file object or library'. There is an alternative and you will end up needing to refer into it a fair bit. Its a built-in function called MacScript. 

You'll want to work out how to do it in AppleScript, and then create that script and run it through MacScript in VBA. Below is an stripped down example of my work in which I have code that either uses Application.FileDialog(msoFileDialogOpen) on a PC or MacScript on a Mac, specifically this is only showing the Mac side.
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
FYI at point of execution in MacScript, StrContainer looked as below: -
tell application "Finder"
choose file with prompt "Select the required Config stub" of type {"Config_Stub"} without invisibles and multiple selections allowed
end tell
Finally, VBA is not available on all versions of Office for Mac and there are subtle differences in ways of working between them that unfortunutly you'll only come to find via experience. Like I say 'You're heading off the edge of the map' into uncharted waters.

                        
这篇关于SaveAs功能适用于Microsoft PC，但不适用于MAC的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！