excel - VBA 宏在运行后什么都不做，没有错误(macos)

Question

这是我在这个平台上的第一个问题，所以请原谅我可能犯的任何错误。
我有几个 excel 工作簿，我想对它们中的精确工作表和精确单元格进行多次精确更改，但是它们太多了，无法单独完成。
我使用其中一个工作簿记录了我要在宏中进行的所有更改；

Sub Macro1()

Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("R35:X35").Select
Selection.Cut
Range("R34").Select
ActiveSheet.Paste
Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
Range("V179:V182").Select

End Sub

我在另一个不同的未修改工作簿中运行了这个宏，它运行良好。
我对使用 VBA 很陌生，但是我能够在网上找到一段代码，它可以更改指定目录中的多个 excel 文件；

Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet

' Change directory path as desired
dirName = "c:\myfiles\"

MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile

Do While MyFile <> ""
    If Len(MyFile) = 0 Then Exit Do 

    Workbooks.Open MyFile

    With ActiveWorkbook
        For Each wks In .Worksheets
            ' Specify the change to make
            wks.Range("A1").Value = "A1 Changed"
        Next
    End With

    ActiveWorkbook.Close SaveChanges:=True

    MyFile = Dir
    If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub 

我对其进行了编辑以适应我的需求；

Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
Set wks = ActiveWorkbook.Worksheets("SHEET X")

' Change directory path as desired
dirName = "/Users/Account/Desktop/Directory 1/Directory 2/"

MyPath = dirName & "*.xls"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile

Do While MyFile <> ""
    If Len(MyFile) = 0 Then Exit Do

    Workbooks.Open MyFile

    With ActiveWorkbook
        For Each wks In ActiveWorkbook.Worksheets
            ' Specify the change to make
            wks.Range("W4:X4").Select
            ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
            wks.Range("J33:M33").Select
            ActiveCell.FormulaR1C1 = "Hz"
            wks.Range("B33:I33").Select
            ActiveCell.FormulaR1C1 = "DETAILS"
            wks.Range("R34:X34").Select
            Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            wks.Range("R35:X35").Select
            Selection.Cut
            wks.Range("R34").Select
            ActiveSheet.Paste
            wks.Range("K68:L123").Select
            Selection.Delete Shift:=xlToLeft
            wks.Range("K68:L68").Select
            ActiveCell.FormulaR1C1 = "UNITS ON BAR"
            wks.Range("V178").Select
            ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
            wks.Range("V179:V182").Select
        Next
    End With

    ActiveWorkbook.Close SaveChanges:=True

    MyFile = Dir
    If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub

我运行它，它什么也没做，也没有返回任何错误。我真的不知所措，我真的很感激任何帮助。
P.S 我是mac用户

Answer 1

好吧，120 个同时打开的标签页(不是开玩笑，我数了数😂)和两个不眠之夜之后，我终于找到了解决方案。注意:这仅适用于 MAC，显然我认为 Dir在 Mac 上不起作用，感谢@Jeeped 指出这一点，所以对于遇到我的问题的其他 Mac 用户，这就是我所做的:

Option Explicit
'Important: this Dim line must be at the top of your module
Dim dirName As String

Sub ChangeFiles()
Dim MySplit As Variant
Dim FileIndirName As Long
Dim wks As Worksheet

'Clear dirName to be sure that it not return old info if no files are found
dirName = ""

Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=1, FileFilterOption:=0, FileNameFilterStr:="SearchString")

If dirName <> "" Then
    With Application
        .ScreenUpdating = False
    End With

    MySplit = Split(dirName, Chr(13))
    For FileIndirName = LBound(MySplit) To UBound(MySplit)

    Workbooks.Open (MySplit(FileIndirName))
    Set wks = ActiveWorkbook.Worksheets("SHEET X")

    With wks
       .Range("W4:X4") = "OFF -PEAK GEM(MW)"
        .Range("J33:M33") = "Hz"
        .Range("B33:I33") = "DETAILS"
        .Range("R34:X34").EntireRow.Insert Shift:=xlShiftDown
        .Range("R35:X35").Cut Destination:=Range("R34")
        .Range("K68:L123").Delete Shift:=xlToLeft
        .Range("K68:L68") = "UNITS ON BAR"
        .Range("V178") = "EXPECTED RESERVE"
    End With

    ActiveWorkbook.Close SaveChanges:=True

    Next FileIndirName
        With Application
            .ScreenUpdating = True
        End With
Else
    MsgBox "Sorry no files that match your criteria, A 0 files result can be due to Apple sandboxing: Try using the Browse button to re-select the folder."
    With Application
        .ScreenUpdating = True
    End With
End If
MsgBox "Done!"
End Sub

'*******Function that do all the work that will be called by the macro*********

Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, _
                                          FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
Dim ScriptToRun As String
Dim folderPath As String
Dim FileNameFilter As String
Dim Extensions As String

On Error Resume Next
folderPath = MacScript("choose folder as string")
If folderPath = "" Then Exit Function
On Error GoTo 0

Select Case ExtChoice
Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)"  'xls, xlsx , xlsm, xlsb
Case 1: Extensions = "xls"    'Only  xls
Case 2: Extensions = "xlsx"    'Only xlsx
Case 3: Extensions = "xlsm"    'Only xlsm
Case 4: Extensions = "xlsb"    'Only xlsb
Case 5: Extensions = "csv"    'Only csv
Case 6: Extensions = "txt"    'Only txt
Case 7: Extensions = ".*"    'All files with extension, use *.* for everything
Case 8: Extensions = "(xlsx|xlsm|xlsb)"  'xlsx, xlsm , xlsb
Case 9: Extensions = "(csv|txt)"   'csv and txt files
    'You can add more filter options if you want,
End Select

Select Case FileFilterOption
Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' "  'No Filter
Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' "    'Begins with
Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' "    ' Ends With
Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' "   'Contains
End Select

folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
                       Chr(34) & " to return quoted form of it's POSIX Path")
folderPath = Replace(folderPath, "'\''", "'\\''")

If Val(Application.Version) < 15 Then
    ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
                  folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                  Level & """)" & Chr(13)
    ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
    ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
    ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
    ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
    ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
    ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
    ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
    ScriptToRun = ScriptToRun & "foundPaths"
Else
    ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
                  folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
                  Level & """ "
End If

On Error Resume Next
dirName = MacScript(ScriptToRun)
On Error GoTo 0
End Function

顺便说一句，@urdearboy 谢谢你的建议，它真的很有帮助，虽然我遇到了 .PasteSpecial 的问题，我仍然找到了解决方法。

对于任何想知道的人，当您运行代码时，它基本上会弹出一个对话框，要求您选择所需的文件夹，当您这样做时，它会找到具有 .xls 扩展名的文件(您可以更改它)并执行更改在该文件夹中的所有 .xls 文件中。

感谢所有评论这篇文章的人。 ^_^