폴더의 통합 문서에서 워크 시트를 반복합니다.

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

이 워크 북을 사용하면 매크로 파일 (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 

Answer 2

유레카! 이 VBA 테이블 헤더 2.2 삽입 5 행으로 모든 통합 문서 2.1 형식 첫 번째 줄의 각 장에서 2.0 ".xlsx '에"로 끝나는 모든 파일을 통해 폴더 2. 루프를 요청합니다 (1) (교대 아래쪽) 2.3 범위 및 3 개의 레이블 (매크로 원본 워크 북에서) 2.4의 이미지를 추가하고 시트 이름과 마지막으로 수정 한 날짜/시간을 나타내는 네 번째 레이블을 추가합니다. 모든 준비는 "회사가 파일/시트를

그리고 마지막으로, 그것은 ... LOL .. (스페인어)

을"작업 완료 "하라는 메시지를 표시하고 다시 실행하는 경우는 건너 뜁니다 "(. 일명 : 범위 ("이름 ...

...

2에서 잠수정을 원하는대로 모드 주시기 바랍니다 ... 한 장에 C1에 C1을 "))

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