In theo số thứ tự (6 người xem)

[Emyeuexcel]

Chào anh chị em GPE,
Mình có file đính kèm có đoạn code (1) (ko biết ai cho mà mình lưu trong máy, xin cảm ơn tác giả của đoạn code).
Giờ mình muốn dùng code này, in theo số thứ tự cột A bên sheet Lot, in theo các số hợp đồng cột B.
Sheet In sẽ in dựa vào ô H1. theo số thứ tự lấy bên sheet Lot.
Nhưng trước khi in, mình muốn lưu file dạng Excel đặt tên file theo cột C bên sheet Lot, rồi Lọc lại cột J, Xóa các dòng có số 0.
(hiện tại code lưu PDF)
Cuối cùng là in ra.
Mong anh chị em giúp mình với ạ!
Xin cảm ơn nhiều!

 

[VetMini]

Chào anh chị em GPE,
Mình có file đính kèm có đoạn code (1) (ko biết ai cho mà mình lưu trong máy, xin cảm ơn tác giả của đoạn code).
Giờ mình muốn dùng code này, in theo số thứ tự cột A bên sheet Lot, in theo các số hợp đồng cột B.
Sheet In sẽ in dựa vào ô H1. theo số thứ tự lấy bên sheet Lot.
Nhưng trước khi in, mình muốn lưu file dạng Excel đặt tên file theo cột C bên sheet Lot, rồi Lọc lại cột J, Xóa các dòng có số 0.
(hiện tại code lưu PDF)
Cuối cùng là in ra.
Mong anh chị em giúp mình với ạ!
Xin cảm ơn nhiều!

Mãi đến giờ mới tìm được đúng góc đăng bài hở

 

[Emyeuexcel]

Mãi đến giờ mới tìm được đúng góc đăng bài hở

View attachment 300483

Đúng rồi bạn. Do lần đầu đăng dạng VBA nên mình không biết chỗ nào. Rất mong anh em thông cảm và giúp mình!

 

[Emyeuexcel]

Chào các anh chị,

Em không hiểu đoạn code sau sai chỗ nào mà chỉ lưu được file với số thứ tự đầu tiên gõ vào, dù nhập 1,2,3 hay 1-3 cũng chỉ lưu cái số 1.
Và không xóa được dòng số 0 cột J.
Không In.

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("Lot").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("Lot").Range("A1:C" & lastRow), 3, False)
ActiveWorkbook.SaveAs Filename:="D:\TAM\" & Filename & ".xlsm"
Sheets("in").Range("H1").Value = aPrint(i)
With Range("A7:K1000")
.AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub

Em có file kèm.
Cảm ơn anh chị xem giúp em với ah!

 

[BuiQuangThuan]

.AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete

Điều kiện lọc ra số lớn 0 mà để thế này thì nó không đúng là phải rồi

 

[yaaasoo01]

Vì sau vòng lặp đầu tiên dòng này sẽ lỗi : .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
=>> Goto Thoat

 

[Emyeuexcel]

Điều kiện lọc ra số lớn 0 mà để thế này thì nó không đúng là phải rồi

Mình thay lại như vậy nó cũng chưa được là vì sao anh ơi?
AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete

Bài đã được tự động gộp: 25/4/24

Vì sau vòng lặp đầu tiên dòng này sẽ lỗi : .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
=>> Goto Thoat

Bạn ơi, do mình không rành VBA, mới mò học nên bạn giúp mình với. Mình thay như vậy : SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete

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("Lot").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("Lot").Range("A1:C" & lastRow), 3, False)
ActiveWorkbook.SaveAs Filename:="D:\TAM\" & Filename & ".xlsm"
Sheets("in").Range("H1").Value = aPrint(i)
With Range("A7:K1000")
.AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub

 

[yaaasoo01]

Mình thay lại như vậy nó cũng chưa được là vì sao anh ơi?
AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete

Bài đã được tự động gộp: 25/4/24

Bạn ơi, do mình không rành VBA, mới mò học nên bạn giúp mình với. Mình thay như vậy : SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete

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("Lot").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("Lot").Range("A1:C" & lastRow), 3, False)
ActiveWorkbook.SaveAs Filename:="D:\TAM\" & Filename & ".xlsm"
Sheets("in").Range("H1").Value = aPrint(i)
With Range("A7:K1000")
.AutoFilter Field:=10, Criteria1:="0"
.SpecialCells(xlCellTypeVisible, 12).EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False
Sheets("in").Range("H1").Value = aPrint(i)
Sheets("in").PrintOut Copies:=1, Preview:=False, PrintToFile:=False
Next i
Thoat:
End Sub

Không được là phần in hay phần xóa?

 

[Emyeuexcel]

Không được là phần in hay phần xóa?

Nó chỉ chạy được số thứ tự đầu tiên, in xóa ok, còn từ số thứ 2 trở đi thì in ra mà không có dòng nào.
Mình hiểu là nó thực hiện vòng lặp trên file vừa save as ra nên sai yêu cầu.
Thay vì phải quay lại active file gốc và thực hiện thì ở đây code không có phần đó.

Giờ mình phải in từng số thì ok, còn nhập 1 dãy từ... đến thì không được.
Các bạn cao nhân giúp mình với!