循环遍历文件夹中工作簿中的工作表

时间:2017-12-13 14:36:54

标签: excel vba loops directory spreadsheet

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

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

这是我目前的代码(3子' s):

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

大肆宣传给#34; The Spread Sheet Guru&#34;的人们,这让我这么远......

2 个答案:

答案 0 :(得分:0)

如果您使用此工作簿,这将仅循环宏文件(Excel Fiel,其中代码编写)中的工作表。因此,您需要传递工作簿 WorkSheetChange00 wb 并循环该工作簿( WorkSheetChange00(作为工作簿))。

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

答案 1 :(得分:0)

<强> 尤里卡!!! 这个VBA会要求一个文件夹 2.循环遍历以&#34; .xlsx&#34;结尾的所有文件。    2.0在每个工作簿的每张表中    2.1将第一行格式化为表格标题    2.2插入5行(向下移动)    2.3从范围和3个标签添加图像(来自宏原点工作簿)    2.4和第四个标签,标志着工作表的名称和最后修改的日期/时间。

最后但并非最不重要的是,它提示&#34;任务已完成&#34; (用西班牙语)..大声笑......

如果再次运行,它将跳过所有准备好的&#34;公司名称&#34; (又名:范围。(&#34; C1&#34;))每张纸上的C1 ......

随意根据自己的喜好调整..

在2个潜艇......

这是工作代码(粘贴在标准模块中):

index()