循环浏览文件夹中工作簿中的工作表

Question

这是一个很好的。 我可以循环浏览工作簿并在上次保存工作簿的工作表上更改/格式化，但我无法更改/格式化/循环拥有多个工作表的工作簿中的剩余工作表，我的代码将无法工作。

注意：宏从单独的 .xlsm 运行。

这是我当前的代码（3 个子）：

Sub DarFormatoExelsEnFolder()
'Revisar todos los archivos xlsx en una carpeta y aplicar formato 
definido

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimizar Macro
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Definir carpeta destino
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'Si es cancelado
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Definir extensiones a dar formato
  myExtension = "*.xlsx*"

'Definir ruta y extensión
  myFile = Dir(myPath & myExtension)

'Revisar todos los archivos en la carpeta
  Do While myFile <> ""
    'Variable de libro abierto
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Confirmación de libro abierto
      DoEvents

    'Cambios al Workbook

WorkSheetChange

     'Guardar y cerrar Workbook actual
  wb.Close SaveChanges:=True

    'Confirmación de libro cerrado
      DoEvents

    'Proximo libro
      myFile = Dir
  Loop

'Aviso de fin de ejecución
  MsgBox "Operación Completada"

ResetSettings:
  'Normalizar excel
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Sub WorkSheetChange()
Dim WS As Worksheet

For Each WS In ThisWorkbook.Worksheets

    Format

Next WS

End Sub

Sub Format()

    'Format certain cells

End Sub

大声表扬“电子表格大师”中的人，他们让我走到了这一步......

Answer 1

尤里卡！！！ 1.这个VBA会要求一个文件夹 2.遍历所有以“.xlsx”结尾的文件 2.0 在每个工作簿的每张纸上 2.1 将第一行格式化为表头 2.2 插入5行（下移） 2.3 从范围和 3 个标签中添加一个图像（来自宏源工作簿） 2.4 和第 4 个标签，用于标记工作表的名称和最后修改的日期/时间。

最后但同样重要的是，它会提示“任务已完成”（西班牙语）..lol...

如果你再次运行，它将跳过所有准备好的文件/工作表，每张工作表都在 C1 中具有“公司名称”（又名：范围。（“C1”））...

随意修改你的喜好..

在2个潜艇...

这是工作代码（粘贴在标准模块中）：

Sub DarFormatoExelsEnFolder()
 Dim wb As Workbook
 Dim myPath As String
 Dim myFile As String
 Dim myExtension As String
 Dim FldrPicker As FileDialog

'Optimizar Macro
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

'Definir carpeta destino
 Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

 With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
 End With

NextCode:
 myPath = myPath
If myPath = "" Then GoTo ResetSettings

myExtension = "*.xlsx*"
myFile = Dir(myPath & myExtension)

Do While myFile <> ""
'Variable de libro abierto
  Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Confirmación de libro abierto
  DoEvents

'Cambios al Workbook

Format wb

'Guardar y cerrar Workbook actual
  wb.Close SaveChanges:=True

'Confirmación de libro cerrado
  DoEvents

'Proximo libro
  myFile = Dir
 Loop

'Aviso de fin de ejecución
 MsgBox "Operación Completada"

ResetSettings:
'Normalizar excel
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub
'_______________________________________________________

Sub Format(wb As Workbook)
Dim i As Integer
Dim ws_num As Integer

Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet 'remember which worksheet is active in the beginning
ws_num = ActiveWorkbook.Worksheets.Count

For i = 1 To ws_num
    ActiveWorkbook.Worksheets(i).Activate

If Range("C1") <> "Company Name" Then

 'Sheet format start

  Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Rows("1:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    'Pega o Llena información y logo predeterminados
    Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F3:F3").Copy Destination:=Range("C1")
        Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F4:F4").Copy Destination:=Range("C2")
            Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("F5:F5").Copy Destination:=Range("C3")
                Workbooks("REPORTE.xlsm").Worksheets("BACKEND").Range("LogoBR").Copy Destination:=Range("A1")
    Range("C4").Select
    ActiveCell.FormulaR1C1 = ActiveSheet.Name & " - Actualizado el: " & ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
    Range("C1:C4").Select
    Range("C4").Activate
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

End If
    'Sheet format end

Range("A1").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
'Numera las hojas
    ActiveWorkbook.Worksheets(i).Cells(1, 1) = 1
Next
'reactiva hoja inicial
starting_ws.Activate

End Sub

Answer 2

如果您使用此工作簿，这只会循环宏文件（编写代码的 Excel 字段）中的工作表。因此，您需要传递工作簿 WorkSheetChange00 wb 并循环该工作簿（WorkSheetChange00(wb as Workbook)）。

Sub WorkSheetChange00(wb as Workbook)
  Dim WS As Worksheet
  For Each WS In wb.Worksheets
     WS.activate
     Format
  Next WS
End Sub

Sub DarFormatoExelsEnFolder()
 Dim wb As Workbook
 Dim myPath As String
 Dim myFile As String
 Dim myExtension As String
 Dim FldrPicker As FileDialog

 'Optimizar Macro
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 Application.Calculation = xlCalculationManual

'Definir carpeta destino
 Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

 With FldrPicker
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    myPath = .SelectedItems(1) & "\"
 End With

 NextCode:
 myPath = myPath
If myPath = "" Then GoTo ResetSettings

myExtension = "*.xlsx*"
myFile = Dir(myPath & myExtension)

Do While myFile <> ""
'Variable de libro abierto
  Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Confirmación de libro abierto
  DoEvents

'Cambios al Workbook

WorkSheetChange00 wb

 'Guardar y cerrar Workbook actual
  wb.Close SaveChanges:=True

'Confirmación de libro cerrado
  DoEvents

'Proximo libro
  myFile = Dir
 Loop

 'Aviso de fin de ejecución
 MsgBox "Operación Completada"

ResetSettings:
'Normalizar excel
 Application.EnableEvents = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub