Nhờ chỉnh sửa code trích lọc và in dữ liệu

Liên hệ QC
huonglien1901

huonglien1901

GPE là ngôi nhà thứ 2 của tôi!!!
Tham gia
17/4/16
Bài viết
2,701
Được thích
2,434
Giới tính
Nam
Nghề nghiệp
Nhân viên kỹ thuật in ấn
Em chào mọi người!

em có vấn đề nhờ mọi người hỗ trợ.

Em có 2 file: File mẫu, file tải trên phần mềm(document)

Yêu cầu của em là:

Trên file mẫu của em có 2 cột
2nd count result (So luong kiem dem lan 2)Verification (Signature)

2 cột này để chèn giữa 2 cột Quanlity và Division vào file document.

Khi chèn 2 cột này vào thì tự động chỉnh dòng và chỉnh cột luôn.

Em có record macro đoạn mã như sau:
PHP: 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+x

    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Windows("filemau.xls").Activate
    Range("G1:H1").Select
    Selection.Copy
    Windows("Document.xls").Activate
    Range("G1").Select
    ActiveSheet.Paste
    Rows("1:1").RowHeight = 51
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .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
    Application.PrintCommunication = True
    Columns("A:J").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Selection.PrintOut Copies:=1, Collate:=True
End Sub
Nhưng khi em chạy code thì xảy ra vấn đề như sau:
1- code bị mất 4 cột cuối không có tiêu đề.
2- chưa tạo được footer chân trang, tạo được số trang.
Em nhờ mọi người hỗ trợ giúp em.,
Yêu cầu như trong file demo em làm.
Em cảm ơn mọi người nhiều!
 

File đính kèm

  • Document.xls
    33.5 KB · Đọc: 6
  • filemau.xls
    47.5 KB · Đọc: 6
  • demo.xlsb
    23.2 KB · Đọc: 7
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huonglien1901 đã viết:
Em chào mọi người!

em có vấn đề nhờ mọi người hỗ trợ.

Em có 2 file: File mẫu, file tải trên phần mềm(document)

Yêu cầu của em là:

Trên file mẫu của em có 2 cột
2nd count result (So luong kiem dem lan 2)Verification (Signature)

2 cột này để chèn giữa 2 cột Quanlity và Division vào file document.

Khi chèn 2 cột này vào thì tự động chỉnh dòng và chỉnh cột luôn.

Em có record macro đoạn mã như sau:
PHP: 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+x

    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Windows("filemau.xls").Activate
    Range("G1:H1").Select
    Selection.Copy
    Windows("Document.xls").Activate
    Range("G1").Select
    ActiveSheet.Paste
    Rows("1:1").RowHeight = 51
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .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
    Application.PrintCommunication = True
    Columns("A:J").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Selection.PrintOut Copies:=1, Collate:=True
End Sub
Nhưng khi em chạy code thì xảy ra vấn đề như sau:
1- code bị mất 4 cột cuối không có tiêu đề.
2- chưa tạo được footer chân trang, tạo được số trang.
Em nhờ mọi người hỗ trợ giúp em.,
Yêu cầu như trong file demo em làm.
Em cảm ơn mọi người nhiều!
Nhấp chuột vào đây để mở rộng...
File thực tế thì 2 cột cần chèn của file mẫu có số liệu gì không bạn? Hay chỉ là chèn hai cột trống với tiêu đề như vậy vào file document?
Nếu như không có dữ liệu thì code trực tiếp trên file document sẽ đơn giản hơn. Còn nếu có dữ liệu, thì có thể phải kiếm tra dữ liệu nữa chứ đâu thể chèn như vậy (tránh lỗi không khớp dòng)
 
Upvote 0
Nhattanktnn đã viết:
File thực tế thì 2 cột cần chèn của file mẫu có số liệu gì không bạn? Hay chỉ là chèn hai cột trống với tiêu đề như vậy vào file document?
Nếu như không có dữ liệu thì code trực tiếp trên file document sẽ đơn giản hơn. Còn nếu có dữ liệu, thì có thể phải kiếm tra dữ liệu nữa chứ đâu thể chèn như vậy (tránh lỗi không khớp dòng)
Nhấp chuột vào đây để mở rộng...
Yêu cầu như trong file này em gửi cho Anh.
 

File đính kèm

  • thu nghiem.xlsb
    17 KB · Đọc: 11
Upvote 0
huonglien1901 đã viết:
Yêu cầu như trong file này em gửi cho Anh.
Nhấp chuột vào đây để mở rộng...
Chạy thử cho file "thử nghiệm" xem sao, mới chỉ chèn cột thôi nha. Chưa có in ấn
PHP: 
Option Explicit
Sub ThuNghiem()
Dim QtyAdd As Range, DivAdd As Range
Const fTxt1 As String = "Quantity"
Const fTxt2 As String = "Division"
Const Txt1 As String = "2nd count result (So luong kiem dem lan 2)"
Const Txt2 As String = "Verification (Signature)"
Const TitleRow As Byte = 1
With Workbooks("Thu nghiem").Sheets("Sheet")
    Set QtyAdd = .Rows(TitleRow).Find(fTxt1)
    Set DivAdd = .Rows(TitleRow).Find(fTxt2)
        If QtyAdd Is Nothing Or DivAdd Is Nothing Or DivAdd.Column - QtyAdd.Column > 1 Then
            MsgBox fTxt1 & " " & fTxt2 & " không lien ke"
            Exit Sub
        End If
    DivAdd.EntireColumn.Resize(, 2).Insert
    QtyAdd.Offset(, 1).Value = Txt1
    QtyAdd.Offset(, 2).Value = Txt2
    .Rows(TitleRow).WrapText = True
    .Rows(TitleRow).RowHeight = 42
    .Range(.Cells(TitleRow, 1), .Cells(TitleRow, .Cells(TitleRow, "XFD") _
    .End(xlToLeft).Column)).EntireColumn.AutoFit
End With
End Sub
 
Upvote 0
Nhattanktnn đã viết:
Chạy thử cho file "thử nghiệm" xem sao, mới chỉ chèn cột thôi nha. Chưa có in ấn
PHP: 
Option Explicit
Sub ThuNghiem()
Dim QtyAdd As Range, DivAdd As Range
Const fTxt1 As String = "Quantity"
Const fTxt2 As String = "Division"
Const Txt1 As String = "2nd count result (So luong kiem dem lan 2)"
Const Txt2 As String = "Verification (Signature)"
Const TitleRow As Byte = 1
With Workbooks("Thu nghiem").Sheets("Sheet")
    Set QtyAdd = .Rows(TitleRow).Find(fTxt1)
    Set DivAdd = .Rows(TitleRow).Find(fTxt2)
        If QtyAdd Is Nothing Or DivAdd Is Nothing Or DivAdd.Column - QtyAdd.Column > 1 Then
            MsgBox fTxt1 & " " & fTxt2 & " không lien ke"
            Exit Sub
        End If
    DivAdd.EntireColumn.Resize(, 2).Insert
    QtyAdd.Offset(, 1).Value = Txt1
    QtyAdd.Offset(, 2).Value = Txt2
    .Rows(TitleRow).WrapText = True
    .Rows(TitleRow).RowHeight = 42
    .Range(.Cells(TitleRow, 1), .Cells(TitleRow, .Cells(TitleRow, "XFD") _
    .End(xlToLeft).Column)).EntireColumn.AutoFit
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh hiểu sai ý em rồi. Ý em là đứng ở file sheet mẫu, khi xuất trên phần mềm xuống có tên file là document.
Em chạy code thì file document chèn 2 cột(
2nd count result (So luong kiem dem lan 2)
Verification (Signature)
bên file mẫu , tự động căn chỉnh dòng và cột và tự động in ra luôn.
Em có code này nhờ Anh chỉnh sửa giúp em.
1. Mỗi vùng chỉ chèn 01 lần, nếu lần 2 thì thông báo vùng này đã chèn rồi.
2. Hiện tại code chỉ in được vùng tiêu đề chưa in hết dữ liệu.

Em cảm ơn anh nhiều!

PHP: 
Sub Macro1()
' 
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+K
  Dim wb As Workbook, sh As Worksheet
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
      .Columns("G:H").Insert Shift:=xlToRight
      ThisWorkbook.ActiveSheet.Range("G1:H1").Copy Destination:=.Range("G1:H1")
      .Rows("1:1").RowHeight = 51
      .Columns("A:J").EntireColumn.AutoFit
      
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = "$A$1:$J$1"
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
 
Upvote 0
huonglien1901 đã viết:
Anh hiểu sai ý em rồi. Ý em là đứng ở file sheet mẫu, khi xuất trên phần mềm xuống có tên file là document.
Em chạy code thì file document chèn 2 cột(
2nd count result (So luong kiem dem lan 2)
Verification (Signature)
bên file mẫu , tự động căn chỉnh dòng và cột và tự động in ra luôn.
Em có code này nhờ Anh chỉnh sửa giúp em.
1. Mỗi vùng chỉ chèn 01 lần, nếu lần 2 thì thông báo vùng này đã chèn rồi.
2. Hiện tại code chỉ in được vùng tiêu đề chưa in hết dữ liệu.

Em cảm ơn anh nhiều!

PHP: 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+K
  Dim wb As Workbook, sh As Worksheet
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
      .Columns("G:H").Insert Shift:=xlToRight
      ThisWorkbook.ActiveSheet.Range("G1:H1").Copy Destination:=.Range("G1:H1")
      .Rows("1:1").RowHeight = 51
      .Columns("A:J").EntireColumn.AutoFit
     
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = "$A$1:$J$1"
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Tôi vẫn hiểu ý bạn, nhưng file mẫu là file trống trơn đúng không (đúng ra là vẫn có các cột với tiêu đề nhưng không có dữ liệu)
Vậy thay vì gọi document từ file mẫu, sao bạn không lưu code thành addin (phải sửa lại code) và khi xuất document từ phần mềm thì gọi addin ra chạy trực tiếp trên file đó?
Code của bạn yêu cầu 2 file đều đang mở, thế lỡ file doc đang đóng thì sao? nếu chỉ cần chèn cột và in ấn cho file doc thì không cần rườm rà vậy!
 
Upvote 0
Nhattanktnn đã viết:
Nhattanktnn đã viết:
Tôi vẫn hiểu ý bạn, nhưng file mẫu là file trống trơn đúng không (đúng ra là vẫn có các cột với tiêu đề nhưng không có dữ liệu)
Nhấp chuột vào đây để mở rộng...
Đúng là như vậy Anh!
Vậy thay vì gọi document từ file mẫu, sao bạn không lưu code thành addin (phải sửa lại code) và khi xuất document từ phần mềm thì gọi addin ra chạy trực tiếp trên file đó?
Code của bạn yêu cầu 2 file đều đang mở, thế lỡ file doc đang đóng thì sao? nếu chỉ cần chèn cột và in ấn cho file doc thì không cần rườm rà vậy!
Nhấp chuột vào đây để mở rộng...
Đúng là em chưa nghĩ đến trường hợp file đóng.
Em chỉ nghĩ trường hợp xuất file trên phần mềm xuống thôi, chưa nghĩ đến trường hợp file đóng.

Anh có ý tưởng nào hay thì hỗ trợ giúp em với.

Em cảm ơn Anh nhiều!
 
Upvote 0
Nhattanktnn đã viết:
Tôi vẫn hiểu ý bạn, nhưng file mẫu là file trống trơn đúng không (đúng ra là vẫn có các cột với tiêu đề nhưng không có dữ liệu)
Vậy thay vì gọi document từ file mẫu, sao bạn không lưu code thành addin (phải sửa lại code) và khi xuất document từ phần mềm thì gọi addin ra chạy trực tiếp trên file đó?
Code của bạn yêu cầu 2 file đều đang mở, thế lỡ file doc đang đóng thì sao? nếu chỉ cần chèn cột và in ấn cho file doc thì không cần rườm rà vậy!
Nhấp chuột vào đây để mở rộng...
Vùng ở đây dựa vào cột Zone, Alley trong file document.
 
Upvote 0
huonglien1901 đã viết:
Em chào mọi người!

em có vấn đề nhờ mọi người hỗ trợ.

Em có 2 file: File mẫu, file tải trên phần mềm(document)

Yêu cầu của em là:

Trên file mẫu của em có 2 cột
2nd count result (So luong kiem dem lan 2)Verification (Signature)

2 cột này để chèn giữa 2 cột Quanlity và Division vào file document.

Khi chèn 2 cột này vào thì tự động chỉnh dòng và chỉnh cột luôn.

Em có record macro đoạn mã như sau:
PHP: 
Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+x

    Selection.Insert Shift:=xlToRight
    Selection.Insert Shift:=xlToRight
    Windows("filemau.xls").Activate
    Range("G1:H1").Select
    Selection.Copy
    Windows("Document.xls").Activate
    Range("G1").Select
    ActiveSheet.Paste
    Rows("1:1").RowHeight = 51
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .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
    Application.PrintCommunication = True
    Columns("A:J").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 0
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$B$1:$J$1"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
    Application.PrintCommunication = True
    Selection.PrintOut Copies:=1, Collate:=True
End Sub
Nhưng khi em chạy code thì xảy ra vấn đề như sau:
1- code bị mất 4 cột cuối không có tiêu đề.
2- chưa tạo được footer chân trang, tạo được số trang.
Em nhờ mọi người hỗ trợ giúp em.,
Yêu cầu như trong file demo em làm.
Em cảm ơn mọi người nhiều!
Nhấp chuột vào đây để mở rộng...
Thử code
Mã: 
Sub InsertColumn_GH()
' Keyboard Shortcut: Ctrl+Shift+K
 
  Dim wb As Workbook, sh As Worksheet
  Set sh = ThisWorkbook.Sheets("Sheet")
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
      If .Range("G1").Value <> sh.Range("G1") Then  'Khong insert cot 2 lan
        .Columns("G:H").Insert Shift:=xlToRight
        sh.Range("G1:H1").Copy Destination:=.Range("G1:H1")
        .Rows("1:1").RowHeight = 51
        .Columns("A:J").EntireColumn.AutoFit
      End If
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = "A:J"
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = .UsedRange.Address
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      ActiveSheet.PrintPreview '***
      'Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
 
Upvote 0
HieuCD đã viết:
Thử code
Mã: 
Sub InsertColumn_GH()
' Keyboard Shortcut: Ctrl+Shift+K

  Dim wb As Workbook, sh As Worksheet
  Set sh = ThisWorkbook.Sheets("Sheet")
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
      If .Range("G1").Value <> sh.Range("G1") Then  'Khong insert cot 2 lan
        .Columns("G:H").Insert Shift:=xlToRight
        sh.Range("G1:H1").Copy Destination:=.Range("G1:H1")
        .Rows("1:1").RowHeight = 51
        .Columns("A:J").EntireColumn.AutoFit
      End If
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = "A:J"
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = .UsedRange.Address
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      ActiveSheet.PrintPreview '***
      'Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Anh ơi!
Em có vấn đề tương tự nhờ Anh hỗ trợ.
Yêu cầu là:
1. Đầu tiên copy 2 cột H và cột I trên file mẫu qua file(book(1,2,3,4)
Trong file Book(1,2,3,4), xóa cột J(Stock Unit), L(Status),N(Adjusted Quantity),O(Adjusted Weight).
2. Ta chèn trước cột A một cột trống trong file Book(1,2,3,4), Sau đó copy cột A (Zone) bên File mẫu dán vào cột A trống vừa tạo.
Sau đó tự động chỉnh dòng và cột.
3. Dữ liệu bên File Book(1,2,3,4) tự động kẻ khung cho dữ liệu.
4. Tự động chỉnh Zoom phóng to phù hợp với dữ liệu
Em có sửa code lại mà nó báo lỗi, Nhờ Anh xem giúp và sửa lỗi giúp em với.
PHP: 
Sub InsertColumn_GH()
' Keyboard Shortcut: Ctrl+Shift+K

  Dim wb As Workbook, sh As Worksheet
  Set sh = ThisWorkbook.Sheets("Sheet")
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
        .Columns("H:I").Insert Shift:=xlToRight
        sh.Range("H1:I1").Copy Destination:=.Range("H1:I1")
        .Columns("J:J", "M:N").Delete
        .Columns("B:B").Insert Shift:=xlToRight
        sh.Range("A1").Copy Destination:=.Range("A1")
        .Rows("1:1").RowHeight = 51
        .Columns("A:K").EntireColumn.AutoFit
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = "A:K"
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = .UsedRange.Address
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      ActiveSheet.PrintPreview '***
      'Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
Em cảm ơn Anh nhiều!
 

File đính kèm

  • filemau.xls
    82.5 KB · Đọc: 5
  • Book4.xlsx
    15.5 KB · Đọc: 3
Lần chỉnh sửa cuối:
Upvote 0
huonglien1901 đã viết:
Anh ơi!
Em có vấn đề tương tự nhờ Anh hỗ trợ.
Yêu cầu là:
1. Đầu tiên copy 2 cột H và cột I trên file mẫu qua file(book(1,2,3,4)
Trong file Book(1,2,3,4), xóa cột J(Stock Unit), L(Status),N(Adjusted Quantity),O(Adjusted Weight).
2. Ta chèn trước cột A một cột trống trong file Book(1,2,3,4), Sau đó copy cột A (Zone) bên File mẫu dán vào cột A trống vừa tạo.
Sau đó tự động chỉnh dòng và cột.
3. Dữ liệu bên File Book(1,2,3,4) tự động kẻ khung cho dữ liệu.
4. Tự động chỉnh Zoom phóng to phù hợp với dữ liệu
Em có sửa code lại mà nó báo lỗi, Nhờ Anh xem giúp và sửa lỗi giúp em với.
PHP: 
Sub InsertColumn_GH()
' Keyboard Shortcut: Ctrl+Shift+K

  Dim wb As Workbook, sh As Worksheet
  Set sh = ThisWorkbook.Sheets("Sheet")
  Set wb = ActiveWorkbook
  If wb.Name <> ThisWorkbook.Name Then
    With wb.ActiveSheet
        .Columns("H:I").Insert Shift:=xlToRight
        sh.Range("H1:I1").Copy Destination:=.Range("H1:I1")
        .Columns("J:J", "M:N").Delete
        .Columns("B:B").Insert Shift:=xlToRight
        sh.Range("A1").Copy Destination:=.Range("A1")
        .Rows("1:1").RowHeight = 51
        .Columns("A:K").EntireColumn.AutoFit
      Application.PrintCommunication = False
      With .PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = "A:K"
      End With
      Application.PrintCommunication = True
      .PageSetup.PrintArea = .UsedRange.Address
      Application.PrintCommunication = False
      With .PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .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 = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .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
      Application.PrintCommunication = True
      ActiveSheet.PrintPreview '***
      'Selection.PrintOut Copies:=1, Collate:=True
    End With
  End If
End Sub
Em cảm ơn Anh nhiều!
Nhấp chuột vào đây để mở rộng...
Chỉnh cho bạn lỗi đầu tiên, còn các lỗi khác tự tìm cách
.Columns("J:J", "M:N").Delete
Thành
Union(.Columns("J:J"), .Columns("M:N")).Delete
 
Upvote 0
Upvote 0
Sau một hồi mày mò em đã sửa được lỗi. Cảm ơn Anh nhiều! Đã hỗ trợ giúp em.
Nếu Anh có code giúp em thì Anh có thể gửi code anh giúp em lên gửi cho em tham khảo. Xem cách làm và học hỏi từ Anh.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
11
Đọc
296
SA_DQ
SA_DQ
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
4
Đọc
143
VetMini
V
ongke0711
  • Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
11 12 13
Trả lời
257
Đọc
25K
Pham Ha 233
Pham Ha 233
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
2
Đọc
109
dung09031989
dung09031989
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
2
Đọc
115
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
4
Đọc
123
Ny Ny 2024
N
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
17
Đọc
322
phutdm
P
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
251
Đọc
13K
ongke0711
ongke0711
N
Định mức nguyên vật liệu
Trả lời
1
Đọc
160
yeudoi
yeudoi
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
7
Đọc
88
Parabol
P
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
1
Đọc
305
PhanTuHuong
PhanTuHuong
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
17
Đọc
201
batista911
B
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
30
Đọc
708
huuthang_bd
huuthang_bd
H
Tính và sắp xếp theo thư tự tăng dần có điều kiệu (có dữ liệu trùng nhau)
Trả lời
1
Đọc
36
bebo021999
B
V
  • Question
Lấy dữ liệu lãi suất từ website Sbv.gov.vn bằng Power Query
Trả lời
1
Đọc
521
Minhhanhsgu
M
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
149
Đọc
95K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
5
Đọc
151
batista911
B
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
247
Hoàng Tuấn 868
H
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
6
Đọc
128
tigertiger
tigertiger
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom