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

  • Thread starter Thread starter kimusd
  • Ngày gửi Ngày gửi
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

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

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

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

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

giaiphap
Chia sẻ cách tạo gợi ý cho hàm trong Excel bằng thư viện ExcelDna.
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
8
Đọc
2K
giaiphap
giaiphap
B
  • Question Question
In hóa đơn tự động
Trả lời
7
Đọc
132
HeSanbi
HeSanbi
anhtuan1066
  • Question Question
Tạo dãy số ngẫu nhiên không trùng
    • Thích
7 8 9
Trả lời
165
Đọc
81K
VetMini
V
X
Tự động giãn dòng và ẩn các dòng bị bỏ trống
Trả lời
9
Đọc
391
HUONGHCKT
H
H
[xin trợ giúp] Tạo tra cứu dữ liệu hàng ngang thành hàng dọc
Trả lời
3
Đọc
53
hoangtuaotrang_hp_vn
H
L
Cắt chuỗi lấy năm và kết quả chuyển sang định dạng number
Trả lời
9
Đọc
143
ptm0412
ptm0412
Gà Công Nghệ
Xin file cách chia tiền lẻ phát cho nhân viên
Trả lời
3
Đọc
134
VetMini
V
tamnt07
Cách filter theo chiều ngang (theo hàng)
Trả lời
11
Đọc
16K
ptm0412
ptm0412
andehuong
Cách thay đổi hyperlink cũ (SubAddress) sang hyperlink mới (SubAddress)
Trả lời
3
Đọc
88
HeSanbi
HeSanbi
SA_DQ
(húc mừng năm mới!
    • Thích
    • Yêu thích
Trả lời
4
Đọc
129
Thóc Sama
Thóc Sama
phanmoi688
Cách sắp xếp dữ liệu cột có điều kiện
Trả lời
6
Đọc
95
phanmoi688
phanmoi688
LuuAnh980
  • Question Question
Code tô màu cột N và cột J không tô đúng.
    • Thích
Trả lời
11
Đọc
166
ptm0412
ptm0412
N
Cách đem một file Excel qua máy khác in mà không bị thay đổi kích thước mặc định
2
Trả lời
36
Đọc
28K
ussh999
U
B
Excel 2016 mở file xls rất chậm, treo
    • Buồn
Trả lời
0
Đọc
48
bmtuanltpt
B
D
Vẽ biểu đồ phân tích doanh thu và lợi nhuận theo mã đơn vị
Trả lời
7
Đọc
1K
hoangtuaotrang_hp_vn
H
125479980
Phát triển một VBE trong Delphi để tạo một cửa sổ công cụ.
Trả lời
10
Đọc
399
nguyendang95
N
Z
Excel 365 tự động đẻ file excel 97-203 khi mở file .xlsx
Trả lời
11
Đọc
788
phuongnt.purchase
P
2
Tìm hàm để hiển thị số
Trả lời
1
Đọc
58
huuthang_bd
huuthang_bd
A
Công thức Excel khuyến khích theo doanh số bán
Trả lời
7
Đọc
157
adad
A
Y
Sắp lịch trực luân phiên
Trả lời
9
Đọc
1K
lequangphuan
lequangphuan
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] TALK SHOW NHỮNG ĐIỀU NHỎ TÁC DỤNG LỚN TRONG PIVOT TABLE
Back
Top Bottom