Nhờ mọi người fix code VBA in tự động từng sheet

[jaycer]

e có đoạn code sau in tự động từng sheet tất cả các file trong 1 thư mục và e đang muốn in bất đầu từ sheet2 đến sheet9 (bỏ sheet1) nhưng không hiểu sao máy cứ in cả sheet1, mọi người giúp em với ạ

Private Sub CommandButton1_Click()
Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceWB As Workbook, DestWB As Workbook
    Dim sh As Worksheet
    Dim i As Integer, j As Integer, Z As Integer
    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Sheets(1).Cells(2, 2)
    FilesInPath = Dir(MyPath & "*.xls*")
    While FilesInPath <> ""
        i = i + 1
        ReDim Preserve MyFiles(1 To i)
        MyFiles(i) = FilesInPath
        FilesInPath = Dir()
    Wend
    For j = 1 To UBound(MyFiles)
        Set SourceWB = Workbooks.Open(MyPath & MyFiles(j))
        For Z = 2 To 9 Step 1
            Set sh = SourceWB.Sheets(Z)
            If sh.Visible <> xlSheetHidden And sh.Index <> 1 Then
                sh.Activate
                sh.PrintOut
            End If
        Next Z
        SourceWB.Close SaveChanges:=False
    Next j
    Application.ScreenUpdating = True
End Sub

 

[nhanly_123]

Để in từ sheet 2 đến sheet 9 (bỏ sheet 1) cho tất cả các file trong thư mục, bạn có thể sửa đoạn code của mình bằng cách thêm một điều kiện kiểm tra trước khi in sheet.

Cụ thể, bạn có thể thay đoạn code:

For Z = 2 To 9 Step 1
 Set sh = SourceWB.Sheets(Z)
If sh.Visible <> xlSheetHidden And sh.Index <> 1 Then
        sh.Activate
        sh.PrintOut
End If
Next Z

bằng:

For Each sh In SourceWB.Sheets
If sh.Index > 1 And sh.Index < 10 And sh.Visible <> xlSheetHidden Then
        sh.PrintOut
End If
Next sh

Đoạn code này sẽ lặp lại cho tất cả các sheet trong mỗi workbook được mở, và chỉ in từ sheet thứ 2 đến sheet thứ 9 (bỏ sheet 1) nếu sheet đó không bị ẩn.

Bạn có thể chạy đoạn code này để kiểm tra xem kết quả có đúng như mong muốn không.

 

[jaycer]

For Each sh In SourceWB.Sheets If sh.Index > 1 And sh.Index < 10 And sh.Visible <> xlSheetHidden Then sh.PrintOut End If Next sh

e thử rồi vẫn k đc a ạ

 

[nhanly_123]

code đầy đủ

Private Sub CommandButton1_Click()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceWB As Workbook, DestWB As Workbook
    Dim sh As Worksheet
    Dim i As Integer, j As Integer, Z As Integer
    
    Application.ScreenUpdating = False
    
    MyPath = ThisWorkbook.Sheets(1).Cells(2, 2)
    FilesInPath = Dir(MyPath & "*.xls*")
    
    While FilesInPath <> ""
        i = i + 1
        ReDim Preserve MyFiles(1 To i)
        MyFiles(i) = FilesInPath
        FilesInPath = Dir()
    Wend
    
    For j = 1 To UBound(MyFiles)
        Set SourceWB = Workbooks.Open(MyPath & MyFiles(j))
        
        For Each sh In SourceWB.Sheets
            If sh.Index > 1 And sh.Index < 10 And sh.Visible <> xlSheetHidden Then
                sh.PrintOut
            End If
        Next sh
        
        SourceWB.Close SaveChanges:=False
    Next j
    
    Application.ScreenUpdating = True
End Sub

 

[jaycer]

code đầy đủ

Private Sub CommandButton1_Click()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceWB As Workbook, DestWB As Workbook
    Dim sh As Worksheet
    Dim i As Integer, j As Integer, Z As Integer
   
    Application.ScreenUpdating = False
   
    MyPath = ThisWorkbook.Sheets(1).Cells(2, 2)
    FilesInPath = Dir(MyPath & "*.xls*")
   
    While FilesInPath <> ""
        i = i + 1
        ReDim Preserve MyFiles(1 To i)
        MyFiles(i) = FilesInPath
        FilesInPath = Dir()
    Wend
   
    For j = 1 To UBound(MyFiles)
        Set SourceWB = Workbooks.Open(MyPath & MyFiles(j))
       
        For Each sh In SourceWB.Sheets
            If sh.Index > 1 And sh.Index < 10 And sh.Visible <> xlSheetHidden Then
                sh.PrintOut
            End If
        Next sh
       
        SourceWB.Close SaveChanges:=False
    Next j
   
    Application.ScreenUpdating = True
End Sub

e thử code vẫn ko dc ạ