Nhờ hướng dẫn tạo macro in hàng loạt phiếu xuất hàng

Liên hệ QC
Emyeuexcel đã viết:
Chào bạn,

Có thể tạo sheet, có list số thứ tự , rồi copy dãy số thứ tự cần in bên sheet Data sang list này.
Do mình ko rành VBA, nên chưa làm cái sheet list số thứ tự đó
Rất mong bạn giúp ah!
Mình luôn biết ơn!
Bài đã được tự động gộp:


Cảm ơn bạn nhiều! Mình sẽ chạy code này và báo lại kết quả nhé!
Thân!
Nhấp chuột vào đây để mở rộng...
Bạn thử code và cách làm của bài #19 chưa? Sao không thấy phản hồi?
Nếu được rồi thì thôi.
 
kimusd đã viết:
Đây là file của mình, bạn giúp mình nhé. Ban đầu mình úp file kia lên vì muốn nhờ hướng dẫn cách tạo macro, sau đó mình học theo đó tự làm macro, nếu sau này có cần thay đổi gì thì mình tự làm cũng được, vì mình ko rành về macro cho lắm nên muốn học. Nhờ bạn giúp đỡ. Ko biết sao mình ko úp file lên đc nữa. Mình sgare link bạn xem giúp mình nha
https://drive.google.com/file/d/0B0L1He2tzg9LMjJVRGNBUTlyUHM/view?usp=drivesdk
Nhấp chuột vào đây để mở rộng...
Sao chia sẻ file lại để quyền truy cập thế, b làm đc rồi, cũng share để mn tham khảo đc k?
1681211526892.png
 
ngocbaovu đã viết:
Bạn tham khảo code này xem:
Sub Printsheet()
Dim startNum As Integer
Dim endNum As Integer
Dim maxNum As Integer
Dim lastRow As Long
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
maxNum = Application.WorksheetFunction.Max(Sheets("Data").Range("A1:A" & lastRow))
startNum = InputBox("Nhap so bat dau:")
endNum = InputBox("Nhap so ket thuc:")
If startNum > endNum Or endNum > maxNum Then
MsgBox "So in khong hop le, hay kiem tra lai!"
Exit Sub
End If
For i = startNum To endNum
Sheets("in").Range("H1").Value = i
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
End Sub

Số bắt đầu và kết thúc được nhập từ Msgbox, số kết thúc phải nhỏ hơn số trong Data.
In bằng máy in mặc định.

​

Nhấp chuột vào đây để mở rộng...
Ah, mà bạn ơi, nếu mình muốn in theo 1 dãy số thứ tự không liên tục thì code này phải như thế nào? Ví dụ in 4, 5, 6, 8, 9, 11, 12
Mong bạn chỉ thêm.
Cảm ơn bạn!
 
Emyeuexcel đã viết:
Dược rồi bạn!
Cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
Cũng với cách dùng InputBox nhưng có 1 kiểu nhập trang in linh hoạt hơn. Bạn có để ý hộp thoại in của Word không? Nó cho phép bạn gõ các trang in bằng cách: 1,2,5,8
hoặc bằng cách: 1-3
hoặc kết hợp: 1,3,5-8,10
 
Emyeuexcel đã viết:
Ah, mà bạn ơi, nếu mình muốn in theo 1 dãy số thứ tự không liên tục thì code này phải như thế nào? Ví dụ in 4, 5, 6, 8, 9, 11, 12
Mong bạn chỉ thêm.
Cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
Bạn dùng code sau (trong Inputbox có gợi ý cách nhập):
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
 
Maika8008 đã viết:
Bạn dùng code sau (trong Inputbox có gợi ý cách nhập):
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã nhiệt tình giúp đỡ mình nhiều lắm!
Mình mới mở lên, chưa thử code. Nhưng chắc sẽ chạy ok!

Mình không biết có tham lam quá không, khi được cái này đòi thêm cái khác. :)
Nhưng bạn ơi! Mình quên nói là mình phải lưu lại từng file được in ra nữa (quên mất vụ này). Nên mình có thêm vào sheet Data, cột M, tên file cần lưu, và ô M1 là ví dụ nơi ổ đĩa, thư mục sẽ lưu. (file đính kèm)
Nếu bạn không phiền, ráng giúp mình thêm đoạn code này với nhé!
Mình vô cùng biết ơn bạn!
 

File đính kèm

  • PAYMENT TRACKING 2023.xlsm
    741.2 KB · Đọc: 4
Bạn thử code sau:
Sub Printsheet()
Dim startNum As Integer
Dim endNum As Integer
Dim maxNum As Integer
Dim lastRow As Long
Dim FSO As Object
Dim Filename As String
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists("D:\TAM") = True Then
Else
FSO.CreateFolder ("D:\TAM")
End If
Set FSO = Nothing
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
maxNum = Application.WorksheetFunction.Max(Sheets("Data").Range("A1:A" & lastRow))
startNum = InputBox("Nhap so bat dau:")
endNum = InputBox("Nhap so ket thuc:")
If startNum > endNum Or endNum > maxNum Then
MsgBox "So in khong hop le, hay kiem tra lai!"
Exit Sub
End If
For i = startNum To endNum
Filename = Application.WorksheetFunction.VLookup(i, Sheets("Data").Range("A1:M" & lastRow), 13, False)
Sheets("in").Range("H1").Value = i
Sheets("in").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\TAM\" & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
End Sub

Thư mục D:\TAM mình để trong code đề phòng trường hợp vô tình sai cấu trúc trong ô M1. Nếu cần thay đổi thì nên thay đổi trong code. Hoặc tạo thư mục TAM trong thư mục chứa file excel cũng được.
File xuất dạng PDF cho dễ kiểm soát. Tên file nếu trùng sẽ ghi đè.
 

File đính kèm

  • PAYMENT TRACKING 2023 (1).xlsm
    731.4 KB · Đọc: 8
ngocbaovu đã viết:
Bạn thử code sau:
Sub Printsheet()
Dim startNum As Integer
Dim endNum As Integer
Dim maxNum As Integer
Dim lastRow As Long
Dim FSO As Object
Dim Filename As String
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists("D:\TAM") = True Then
Else
FSO.CreateFolder ("D:\TAM")
End If
Set FSO = Nothing
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
maxNum = Application.WorksheetFunction.Max(Sheets("Data").Range("A1:A" & lastRow))
startNum = InputBox("Nhap so bat dau:")
endNum = InputBox("Nhap so ket thuc:")
If startNum > endNum Or endNum > maxNum Then
MsgBox "So in khong hop le, hay kiem tra lai!"
Exit Sub
End If
For i = startNum To endNum
Filename = Application.WorksheetFunction.VLookup(i, Sheets("Data").Range("A1:M" & lastRow), 13, False)
Sheets("in").Range("H1").Value = i
Sheets("in").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\TAM\" & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
End Sub

Thư mục D:\TAM mình để trong code đề phòng trường hợp vô tình sai cấu trúc trong ô M1. Nếu cần thay đổi thì nên thay đổi trong code. Hoặc tạo thư mục TAM trong thư mục chứa file excel cũng được.
File xuất dạng PDF cho dễ kiểm soát. Tên file nếu trùng sẽ ghi đè.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn!
Mà minh dùng code này nếu in số thứ tự không liên tục thì sẽ không được.
Nên mình dùng code của bạn Maika8008 đang ổn. Chỉ là thêm phần code lưu file.
Bài đã được tự động gộp:

Maika8008 đã viết:
Bạn dùng code sau (trong Inputbox có gợi ý cách nhập):
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi, sao mình copy file này vào ổ chung mạng LAN thì nó không in được, mặc dù không báo lỗi gì. Cũng file đó, nếu trên ổ D, hay C (máy của mình) thì chạy bình thường.
 
Maika8008 đã viết:
Bạn dùng code sau (trong Inputbox có gợi ý cách nhập):
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi, sao giờ mình áp dụng vào in với Data nhiều dòng hơn thì nó không chạy, không in được.
File đính kèm, bạn xem lại giúp mình với!
 

File đính kèm

  • PAYMENT TRACKING 2023.xlsm
    749.2 KB · Đọc: 5
Emyeuexcel đã viết:
Bạn ơi, sao giờ mình áp dụng vào in với Data nhiều dòng hơn thì nó không chạy, không in được.
File đính kèm, bạn xem lại giúp mình với!
Nhấp chuột vào đây để mở rộng...
Tôi không biết dòng lệnh in Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False hoạt động thế nào vì tôi không có máy in, còn tất cả các dòng lệnh còn lại đều chạy tốt.
 
Maika8008 đã viết:
Tôi không biết dòng lệnh in Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False hoạt động thế nào vì tôi không có máy in, còn tất cả các dòng lệnh còn lại đều chạy tốt.
Nhấp chuột vào đây để mở rộng...
Cũng code này mình chạy lúc sáng với file demo thì ok. Không hiểu sao khi thêm dữ liệu vào nó không chạy được
 
Maika8008 đã viết:
không biết dòng lệnh in Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False hoạt động thế nào
Nhấp chuột vào đây để mở rộng...
Truyền 1 lệnh in tới máy in để in mực lên tờ giấy, số bản in =1, xem trước khi in = không, in thành tập tin = không.

Maika8008 đã viết:
tất cả các dòng lệnh còn lại đều chạy tốt.
Nhấp chuột vào đây để mở rộng...

in thường và In viết hoa khác nhau.
 
Code của Maika8008 có bỏ qua trường hợp inputbox chỉ nhập 1 số, không có dấu ",". Dựa vào code của Maika8008 và yêu cầu lưu file, bạn tham khảo code sau:

Sub PrintMultiPage()
Dim sInput$, inputArr() As String, sNote$, Filename$
Dim aPrint() As Long, i&, j&, k&, lastRow&, startNum&, endNum&
Dim FSO As Object
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists("D:\TAM") = True Then
Else
FSO.CreateFolder ("D:\TAM")
End If
Set FSO = Nothing
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
"Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
inputArr = Split(sInput, ",")
For i = LBound(inputArr) To UBound(inputArr)
If InStr(inputArr(i), "-") > 0 Then
startNum = CLng(Left(inputArr(i), InStr(inputArr(i), "-") - 1))
endNum = CLng(Right(inputArr(i), Len(inputArr(i)) - InStr(inputArr(i), "-")))
For j = startNum To endNum
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = j
Next j
Else
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = CLng(inputArr(i))
End If
Next i
For i = LBound(aPrint) To UBound(aPrint)
Filename = Application.WorksheetFunction.VLookup(aPrint(i), Sheets("Data").Range("A1:M" & lastRow), 13, False)
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\TAM\" & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
 

File đính kèm

  • PAYMENT TRACKING 2023 (3).xlsm
    742.7 KB · Đọc: 8
ngocbaovu đã viết:
Code của Maika8008 có bỏ qua trường hợp inputbox chỉ nhập 1 số, không có dấu ",".
Nhấp chuột vào đây để mở rộng...
Hà hà, khi làm xong quên mất thử trường hợp đó, chốt hạ:
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
Else
    ReDim aPrint(1 To 1)
    aPrint(1) = sInput
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
 
befaint đã viết:
Truyền 1 lệnh in tới máy in để in mực lên tờ giấy, số bản in =1, xem trước khi in = không, in thành tập tin = không.



in thường và In viết hoa khác nhau.
Nhấp chuột vào đây để mở rộng...
Cảm ơn "Befaint" góp ý!
Thật ra ban đầu mình cũng không để ý lắm in và In, vì lúc ban đầu mừng quá, chạy thử với in thường, dù file In hoa, thì vẫn ok.
Khi bị lỗi mình, đọc kỹ xem bị chỗ nào, thì thấy "in", mình thử sửa "In" nhưng vẫn không được.
Có khi nào có 1 dòng trống trong Data, nó ko chạy được?
Bài đã được tự động gộp:

Maika8008 đã viết:
Máy người khác thế nào không biết chứ máy tôi không phân biệt Sheets("in") và Sheets("In")
Nhấp chuột vào đây để mở rộng...
Chính xác, do Sheet "Data", trong quá trình copy dữ liệu nhiều dòng, có 1 dòng trống chen ngang, nên nó ko chạy. Mình xóa dòng đó thì ngon lành rồi!
Toát mồ hôi với nó!
Cảm ơn bạn!
Bài đã được tự động gộp:

ngocbaovu đã viết:
Code của Maika8008 có bỏ qua trường hợp inputbox chỉ nhập 1 số, không có dấu ",". Dựa vào code của Maika8008 và yêu cầu lưu file, bạn tham khảo code sau:

Sub PrintMultiPage()
Dim sInput$, inputArr() As String, sNote$, Filename$
Dim aPrint() As Long, i&, j&, k&, lastRow&, startNum&, endNum&
Dim FSO As Object
lastRow = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
Set FSO = CreateObject("scripting.FileSystemObject")
If FSO.FolderExists("D:\TAM") = True Then
Else
FSO.CreateFolder ("D:\TAM")
End If
Set FSO = Nothing
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
"Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
inputArr = Split(sInput, ",")
For i = LBound(inputArr) To UBound(inputArr)
If InStr(inputArr(i), "-") > 0 Then
startNum = CLng(Left(inputArr(i), InStr(inputArr(i), "-") - 1))
endNum = CLng(Right(inputArr(i), Len(inputArr(i)) - InStr(inputArr(i), "-")))
For j = startNum To endNum
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = j
Next j
Else
k = k + 1
ReDim Preserve aPrint(1 To k)
aPrint(k) = CLng(inputArr(i))
End If
Next i
For i = LBound(aPrint) To UBound(aPrint)
Filename = Application.WorksheetFunction.VLookup(aPrint(i), Sheets("Data").Range("A1:M" & lastRow), 13, False)
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\TAM\" & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã nhiệt tình giúp mình, dù mình yêu cầu đủ thứ!
Đa tạ!
Bài đã được tự động gộp:

Maika8008 đã viết:
Hà hà, khi làm xong quên mất thử trường hợp đó, chốt hạ:
Rich (BB code): 
Sub PrintMultiPage()
Dim aTemp As Variant, aPrint() As Variant, i&, j&, k&, pMax&, sInput$, sNote$
pMax = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Value
sNote = "Nhap tung trang in, VD: 5" & vbNewLine & "Hoac theo dang: 1,3,4,..." & vbNewLine & _
       "Hoac dang: 1-4" & vbNewLine & "Hoac ket hop: 1,3,5-8,10"
sInput = InputBox(sNote, "Kieu trang in")
On Error GoTo Thoat
If InStr(1, sInput, ",") Then
    aTemp = Split(sInput, ",")
    If InStr(1, sInput, "-") Then
        For i = 0 To UBound(aTemp)
            If InStr(1, aTemp(i), "-") Then
                For j = Left(aTemp(i), InStr(1, aTemp(i), "-") - 1) To Mid(aTemp(i), InStr(1, aTemp(i), "-") + 1)
                    k = k + 1: ReDim Preserve aPrint(1 To k)
                    aPrint(k) = j
                Next
            Else
                k = k + 1: ReDim Preserve aPrint(1 To k)
                aPrint(k) = aTemp(i)
            End If
        Next
    Else
        ReDim aPrint(1 To UBound(aTemp) + 1)
        For i = 0 To UBound(aTemp)
            aPrint(i + 1) = aTemp(i)
        Next
    End If
Else
    ReDim aPrint(1 To 1)
    aPrint(1) = sInput
End If
For i = LBound(aPrint) To UBound(aPrint)
    Sheets("in").Range("H1").Value = aPrint(i)
    Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã bổ sung cho hoàn chỉnh!
 
Lần chỉnh sửa cuối:
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

S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
22
shnhatha221108
S
T
Không hiện dữ liệu ở ô công thức
Trả lời
3
Đọc
57
thien-16
T
H
Kết nối vba với Database host (hiện tại đang làm host web)
Trả lời
1
Đọc
69
befaint
befaint
trantrimmo
Xin code VBA xuất pdf từ 3 sheet theo lấy thông tin theo tên sheet ạ.
Trả lời
0
Đọc
68
trantrimmo
trantrimmo
hoangtran1176
  • Question
Xuất dữ liệu thông tin khi có mã sản phẩm trùng nhau.
Trả lời
12
Đọc
216
hoangtran1176
hoangtran1176
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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