这是一个很好的。 我可以循环工作簿并在上次保存工作簿的工作表上更改/格式化,但我无法更改/格式化/循环遍历具有多个工作表的工作簿中的剩余工作表,我的代码无法工作。
注意:宏从单独的.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;的人们,这让我这么远......
答案 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()