2016-08-01 3 views
4

これで、約100個のExcelファイルがフォルダに.xmlとして保存され、すべてのワークブックの各ワークシートのレイアウト設定をフォーマットするVBAコードが作成されました(ファイル)を私のフォルダに保存します。しかし、問題はコードがすべてのワークブックの最後のワークシートで機能しないことです。残りのワークフロー、つまり各ワークブックの最後のワークシートまで完全に正常に動作します。ここ はコードです:フォルダに保存された.xmlファイルをループしてVBAを使用してフォーマットする

Sub LoopAllExcelFilesInFolder() 

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

'Optimize Macro Speed 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 

'Retrieve Target Folder Path From User 
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 

'In Case of Cancel 
NextCode: 
myPath = myPath 
If myPath = "" Then GoTo ResetSettings 

'Target File Extension (must include wildcard "*") 
myExtension = "*.xml" 

'Target Path with Ending Extention 
myFile = Dir(myPath & myExtension) 

'Loop through each Excel file in folder 
Do While myFile <> "" 
    'Set variable equal to opened workbook 
    Set wb = Workbooks.Open(Filename:=myPath & myFile) 

    ' added this line, loop through all worksheets in current wb 
    For Each sht In wb.Worksheets 

     'Change the layout 
     Application.PrintCommunication = False 
     With sht.PageSetup 
      .PrintTitleRows = "" 
      .PrintTitleColumns = "" 
     End With 
     Application.PrintCommunication = True 
     ActiveSheet.PageSetup.PrintArea = "" 
     Application.PrintCommunication = False 
     With sht.PageSetup 
      .LeftHeader = "" 
      .CenterHeader = "" 
      .RightHeader = "" 
      .LeftFooter = "" 
      .CenterFooter = "" 
      .RightFooter = "" 
      .LeftMargin = Application.InchesToPoints(0.7) 
      .RightMargin = Application.InchesToPoints(0.7) 
      .TopMargin = Application.InchesToPoints(0.75) 
      .BottomMargin = Application.InchesToPoints(0.75) 
      .HeaderMargin = Application.InchesToPoints(0.3) 
      .FooterMargin = Application.InchesToPoints(0.3) 
      .PrintHeadings = False 
      .PrintGridlines = False 
      .PrintComments = xlPrintNoComments 
      .PrintQuality = 600 
      .CenterHorizontally = False 
      .CenterVertically = False 
      .Orientation = xlLandscape 
      .Draft = False 
      .PaperSize = xlPaperLetter 
      .FirstPageNumber = xlAutomatic 
      .Order = xlDownThenOver 
      .BlackAndWhite = False 
      .Zoom = False 
      .FitToPagesWide = 1 
      .FitToPagesTall = False 
      .PrintErrors = xlPrintErrorsDisplayed 
      .OddAndEvenPagesHeaderFooter = False 
      .DifferentFirstPageHeaderFooter = False 
      .ScaleWithDocHeaderFooter = True 
      .AlignMarginsHeaderFooter = True 
      .EvenPage.LeftHeader.Text = "" 
      .EvenPage.CenterHeader.Text = "" 
      .EvenPage.RightHeader.Text = "" 
      .EvenPage.LeftFooter.Text = "" 
      .EvenPage.CenterFooter.Text = "" 
      .EvenPage.RightFooter.Text = "" 
      .FirstPage.LeftHeader.Text = "" 
      .FirstPage.CenterHeader.Text = "" 
      .FirstPage.RightHeader.Text = "" 
      .FirstPage.LeftFooter.Text = "" 
      .FirstPage.CenterFooter.Text = "" 
      .FirstPage.RightFooter.Text = "" 
     End With 
    Next sht 

    'Save and Close Workbook 
    wb.Close SaveChanges:=True 

    'Get next file name 
    myFile = Dir 
Loop 

'Message Box when tasks are completed 
MsgBox "Task Complete!" 

ResetSettings: 
'Reset Macro Optimization Settings 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 

私が間違っていた場所を私に教えてください。 おかげ

+1

何、言ってすべての行を削除しますか?エラーがありますか(あれば、どの行にありますか)?期待どおりに振る舞いませんか? – Mikegrann

+0

@Mikegrannいいえエラーはありません。各ブックの最後のシートは書式設定されません。したがって、私が望むように完全に振る舞いません。 – Karan

+0

ループが 'For each sht In wb.Worksheets'で始まる直後に' sht.Activate'行を追加します。 – dbmitch

答えて

0

はまさに、うまくいか

Application.PrintCommunication = False 
Application.PrintCommunication = True 
関連する問題