Xin nhờ tạo UserForm in theo lựa chọn (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
vc_đi chơi

vc_đi chơi

Thành viên thường trực
Tham gia
21/9/19
Bài viết
201
Được thích
41
Thân ái chào các anh, chị và các bạn trên GPE!
Xin giúp đỡ tôi tạo Form để in dữ liệu
Sheet(VB) được lấy số liệu từ cột thứ tự bên sheet(Tên)
In sheet(VB) theo thứ tự bên sheet(Ten).
Form in có thể chọn theo 2 kiểu:
1/ in từ số này đến số này
2/ In tùy theo số chọn: 1,3,6...
Tôi xin cảm ơn! mong các anh,chị và các bạn giúp!



2222.pngmmmmm.png
 

File đính kèm

vc_đi chơi đã viết:
Thân ái chào các anh, chị và các bạn trên GPE!
Xin giúp đỡ tôi tạo Form để in dữ liệu
Sheet(VB) được lấy số liệu từ cột thứ tự bên sheet(Tên)
In sheet(VB) theo thứ tự bên sheet(Ten).
Form in có thể chọn theo 2 kiểu:
1/ in từ số này đến số này
2/ In tùy theo số chọn: 1,3,6...
Tôi xin cảm ơn! mong các anh,chị và các bạn giúp!



View attachment 227922View attachment 227923
Nhấp chuột vào đây để mở rộng...
Sau một hồi lần mò em đã tìm ra in từ số này đến số này!
Còn in theo số chọn (1,3,5,6)
Nhờ các bác giúp em mới.
Mã: 
Private Sub CommandButton1_Click()
Dim sobatdau As Integer
Dim soketthuc As Integer
sobatdau = txtsobatdau.Text
soketthuc = txtsoketthuc.Text

Dim i As Integer

For i = sobatdau To soketthuc Step 1
Trang_tính1.Range("B8").Value = i
Trang_tính2.PrintOut

Next

End Sub

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Click()

End Sub
aaaaa.png
 

File đính kèm

Thì bạn mò mẫm tiếp xem sao:
1./ Ở lần trước bạn lấy số bản in bắ đầu từ 1 TextBox & bản in cuối từ 1 TextBox khác, thì giờ đây bạn sẽ phải xử lý các ký số bản in mà bạn cần chỉ trên 1 TextBox, & nhập có dạng 2,4,6,
Có nghĩa là các bản in cách nhau 1 dấu phảy & cuối cùng là 1 dấu phảy
2./ Lần trước bạn xài vòng lặp For .. Next thì giờ bạn sẽ phải xài vòng Do . . . . Loop
Điều kiện để thoát vòng lặp sẽ là dấu phảy cuối cùng
Để xác định dấu phảy cuối ta có vài cách, cùi bắp nhất là xài hàm InStr(), ví dụ: VTr = InStr(3, "GPE.COM", ".")

(Mình không có máy in nên đành khuyến cáo vậy thôi, bạn thông cảm & tiếp tục thử xem!)
 
SA_DQ đã viết:
Thì bạn mò mẫm tiếp xem sao:
1./ Ở lần trước bạn lấy số bản in bắ đầu từ 1 TextBox & bản in cuối từ 1 TextBox khác, thì giờ đây bạn sẽ phải xử lý các ký số bản in mà bạn cần chỉ trên 1 TextBox, & nhập có dạng 2,4,6,
Có nghĩa là các bản in cách nhau 1 dấu phảy & cuối cùng là 1 dấu phảy
2./ Lần trước bạn xài vòng lặp For .. Next thì giờ bạn sẽ phải xài vòng Do . . . . Loop
Điều kiện để thoát vòng lặp sẽ là dấu phảy cuối cùng
Để xác định dấu phảy cuối ta có vài cách, cùi bắp nhất là xài hàm InStr(), ví dụ: VTr = InStr(3, "GPE.COM", ".")

(Mình không có máy in nên đành khuyến cáo vậy thôi, bạn thông cảm & tiếp tục thử xem!)
Nhấp chuột vào đây để mở rộng...
Chúc anh ngày mới nhiều niềm vui!
em chưa hiểu về VBA nên mày mò là tìm trên mạng và lắp ghép, em chưa viết code được.
Phiền anh giúp em ạ!
 
Mình nói rồi: Do không có máy in nên sẽ không thể viết cho bạn, 1 khi chưa thử nghiệm trên thực địa!
 

File đính kèm

  • Baba.jpg
    Baba.jpg
    895 KB · Đọc: 16
vc_đi chơi đã viết:
Thân ái chào các anh, chị và các bạn trên GPE!
Xin giúp đỡ tôi tạo Form để in dữ liệu
Sheet(VB) được lấy số liệu từ cột thứ tự bên sheet(Tên)
In sheet(VB) theo thứ tự bên sheet(Ten).
Form in có thể chọn theo 2 kiểu:
1/ in từ số này đến số này
2/ In tùy theo số chọn: 1,3,6...
Tôi xin cảm ơn! mong các anh,chị và các bạn giúp!



View attachment 227922View attachment 227923
Nhấp chuột vào đây để mở rộng...
Thiết kế lại file cho đơn giản, bạn khai báo lại địa chỉ
Mã: 
Sub RoundedRectangle1_Click()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("G3").Value = sArr(i, 1)
    Range("E1:J16").PrintPreview ' Xem truoc khi in
    'Range("E1:J16").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub RoundedRectangle2_Click()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("G3").Value = sArr(ik, 1)
        Range("E1:J16").PrintPreview ' Xem truoc khi in
        'Range("E1:J16").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
vùng In
 

File đính kèm

Bạn tham khảo thử
Code này mình đi ăn trộm về. Anh chị ngang qua đừng mách anh ấy nhé. Em làm banh ta lông Code của Anh ấy rồi
 

File đính kèm

Nhất Chi Lan đã viết:
Bạn tham khảo thử
Code này mình đi ăn trộm về. Anh chị ngang qua đừng mách anh ấy nhé. Em làm banh ta lông Code của Anh ấy rồi
Nhấp chuột vào đây để mở rộng...
Tôi cám ơn bạn! rất hay.
Bài đã được tự động gộp:

HieuCD đã viết:
Thiết kế lại file cho đơn giản, bạn khai báo lại địa chỉ
Mã: 
Sub RoundedRectangle1_Click()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("G3").Value = sArr(i, 1)
    Range("E1:J16").PrintPreview ' Xem truoc khi in
    'Range("E1:J16").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub RoundedRectangle2_Click()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("G3").Value = sArr(ik, 1)
        Range("E1:J16").PrintPreview ' Xem truoc khi in
        'Range("E1:J16").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
vùng In
Nhấp chuột vào đây để mở rộng...
Cám ơn anh
HieuCD đã viết:
Thiết kế lại file cho đơn giản, bạn khai báo lại địa chỉ
Mã: 
Sub RoundedRectangle1_Click()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("G3").Value = sArr(i, 1)
    Range("E1:J16").PrintPreview ' Xem truoc khi in
    'Range("E1:J16").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub RoundedRectangle2_Click()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("G3").Value = sArr(ik, 1)
        Range("E1:J16").PrintPreview ' Xem truoc khi in
        'Range("E1:J16").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
vùng In
Nhấp chuột vào đây để mở rộng...
Cám ơn Anh HieuCD!
 
HieuCD đã viết:
Thiết kế lại file cho đơn giản, bạn khai báo lại địa chỉ
Mã: 
Sub RoundedRectangle1_Click()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("G3").Value = sArr(i, 1)
    Range("E1:J16").PrintPreview ' Xem truoc khi in
    'Range("E1:J16").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub RoundedRectangle2_Click()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("Ten")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:C" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("G3").Value = sArr(ik, 1)
        Range("E1:J16").PrintPreview ' Xem truoc khi in
        'Range("E1:J16").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
vùng In
Nhấp chuột vào đây để mở rộng...
Anh cho em hỏi thêm vấn để này chút ạ!
Nếu em có thêm một "cặp Sheet" kiểu như ví dụ nêu trên nữa mà cũng muốn in kiểu vậy
Thì phải sửa code ở đoạn nào anh?:
Em tạo thêm một mudule giống module anh đã giúp em và chỉnh sửa Sub thành tên mới, và các tên sheet và các vị trí ô cũng thay đổi thao.
Em xem code chỉ thấy có tên sheet cần lấy dữ liệu, mà không thấy tên sheet cần điền dữ liệu sang.
Mã: 
With Sheets("Ten")
Nên nếu em muốn thêm một "cặp" sheet là shee "D" và sheet "E"
Sheet cần lấy dữ liều là "D" và dữ liệu được lấy sang sheet"E"
Thì phải thêm một mudule mới, chép đoạn code anh giúp vào và chỉnh sửa code như thế nào vậy anh?
Những ô trong "E" tô nền vàng là những ô được lấy dữ liệu liên kết từ "D" sang khi Spin.
Code em đăng bài 1 khi in có sử dụng kết hợp với hàm Vlookup(), lấy dữ liệu từ vùng Vlookup().
Anh xem giúp em.
77777.png
888888888.png
 

File đính kèm

Lần chỉnh sửa cuối:
Nhất Chi Lan đã viết:
Bạn tham khảo thử
Code này mình đi ăn trộm về. Anh chị ngang qua đừng mách anh ấy nhé. Em làm banh ta lông Code của Anh ấy rồi
Nhấp chuột vào đây để mở rộng...
Bạn ơi cho mình hỏi chút nhé!
Mình xem code bạn giúp thì thấy:
Trong các Module không thấy tên sheet cần lấy dữ liệu và sheet được lấy dữ liệu sang
View code trong Form_printts thì thấy chỉ có sub UserForm_Initialize() là có tên sheet cần lấy dữ liệu
Mã: 
Private Sub UserForm_Initialize()
    Dim I As Long, K As Long
    With Sheets("Ten")
        If .Range("B" & Rows.Count).End(xlUp).Row < 6 Then
            MsgBox "Khong co du lieu"
            End
Giờ mình muốn áp dụng cho một "cặp" sheet để lấy kiểu dữ liệu như trên thì phải tạo 1 Form nhập liệu mới và các code trong Form bạn viết giúp này có thể dùng được để chỉnh sửa cho Form mới mình đã tạo không?
Cám ơn bạn!
 
vc_đi chơi đã viết:
Anh cho em hỏi thêm vấn để này chút ạ!
Nếu em có thêm một "cặp Sheet" kiểu như ví dụ nêu trên nữa mà cũng muốn in kiểu vậy
Thì phải sửa code ở đoạn nào anh?:
Em tạo thêm một mudule giống module anh đã giúp em và chỉnh sửa Sub thành tên mới, và các tên sheet và các vị trí ô cũng thay đổi thao.
Em xem code chỉ thấy có tên sheet cần lấy dữ liệu, mà không thấy tên sheet cần điền dữ liệu sang.
Mã: 
With Sheets("Ten")
Nên nếu em muốn thêm một "cặp" sheet là shee "D" và sheet "E"
Sheet cần lấy dữ liều là "D" và dữ liệu được lấy sang sheet"E"
Thì phải thêm một mudule mới, chép đoạn code anh giúp vào và chỉnh sửa code như thế nào vậy anh?
Những ô trong "E" tô nền vàng là những ô được lấy dữ liệu liên kết từ "D" sang khi Spin.
Anh xem giúp em.
View attachment 227975
View attachment 227976
Nhấp chuột vào đây để mở rộng...
Không có tên Sheet là mặc đinh sheet hiện hành, là sheet có các nút lệnh
Tại sao không có số thứ tự 2?
 
vc_đi chơi đã viết:
Bạn ơi cho mình hỏi chút nhé!
Mình xem code bạn giúp thì thấy:
Trong các Module không thấy tên sheet cần lấy dữ liệu và sheet được lấy dữ liệu sang
View code trong Form_printts thì thấy chỉ có sub UserForm_Initialize() là có tên sheet cần lấy dữ liệu
Mã: 
Private Sub UserForm_Initialize()
    Dim I As Long, K As Long
    With Sheets("Ten")
        If .Range("B" & Rows.Count).End(xlUp).Row < 6 Then
            MsgBox "Khong co du lieu"
            End
Giờ mình muốn áp dụng cho một "cặp" sheet để lấy kiểu dữ liệu như trên thì phải tạo 1 Form nhập liệu mới và các code trong Form bạn viết giúp này có thể dùng được để chỉnh sửa cho Form mới mình đã tạo không?
Cám ơn bạn!
Nhấp chuột vào đây để mở rộng...
Bạn thử đưa dữ liệu thật lên xem nào. Chứ cót két mỗi lần cấu trúc thay đổi thì lại phải chỉnh lại mất công lắm
 
HieuCD đã viết:
Không có tên Sheet là mặc đinh sheet hiện hành, là sheet có các nút lệnh
Tại sao không có số thứ tự 2?
Nhấp chuột vào đây để mở rộng...
À em vừa tải lại file cho đúng số thứ tự, em không biết code nên chỉ nhìn thấy chỗ nào có tên sheet hoặc vùng là thay thôi.
Nhờ anh xe giúp em để em cũng như mọi người có thể áp dụng linh hoạt với người chưa hiểu về code như em
Cám ơn anh!
Bài đã được tự động gộp:

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn thử đưa dữ liệu thật lên xem nào. Chứ cót két mỗi lần cấu trúc thay đổi thì lại phải chỉnh lại mất công lắm
Nhấp chuột vào đây để mở rộng...
Không phải là dữ liệu không thật đâu bạn, mình muốn nếu có thể thì có thể áp dụng linh hoạt.
Vâng, tại vì mình do công việc giả sử mình muốn thêm dữ liệu vào (một cặp sheet) kiểu vậy, thì hỏi bạn có thể chỉnh sửa như nào cho linh động
Mình hiểu là sẽ tạo thêm một Form mới, và muốn tận dụng code từ Form cũ của bạn. Nếu được bạn giúp.
File sau mình thêm vào 02 sheet "D" và "E"
Cần lấy dữ liệu từ "D" sang "E"
Cám ơn bạn nhé!
 

File đính kèm

Lần chỉnh sửa cuối:
vc_đi chơi đã viết:
À em vừa tải lại file cho đúng số thứ tự, em không biết code nên chỉ nhìn thấy chỗ nào có tên sheet hoặc vùng là thay thôi.
Nhờ anh xe giúp em để em cũng như mọi người có thể áp dụng linh hoạt với người chưa hiểu về code như em
Cám ơn anh!
Bài đã được tự động gộp:


Không phải là dữ liệu không thật đâu bạn, mình muốn nếu có thể thì có thể áp dụng linh hoạt.
Vâng, tại vì mình do công việc giả sử mình muốn thêm dữ liệu vào (một cặp sheet) kiểu vậy, thì hỏi bạn có thể chỉnh sửa như nào cho linh động
Mình hiểu là sẽ tạo thêm một Form mới, và muốn tận dụng code từ Form cũ của bạn. Nếu được bạn giúp.
File sau mình thêm vào 02 sheet "D" và "E"
Cần lấy dữ liệu từ "D" sang "E"
Cám ơn bạn nhé!
Nhấp chuột vào đây để mở rộng...
1573213615837.png
- Selected data: Vùng dữ liệu nguồn (bao gồm cả tiêu đề)
- Destination: Ô đích chứa số thứ tự (Trong File là E3)
 

File đính kèm

File đính kèm

vc_đi chơi đã viết:
Anh cho em hỏi thêm vấn để này chút ạ!
Nếu em có thêm một "cặp Sheet" kiểu như ví dụ nêu trên nữa mà cũng muốn in kiểu vậy
Thì phải sửa code ở đoạn nào anh?:
Em tạo thêm một mudule giống module anh đã giúp em và chỉnh sửa Sub thành tên mới, và các tên sheet và các vị trí ô cũng thay đổi thao.
Em xem code chỉ thấy có tên sheet cần lấy dữ liệu, mà không thấy tên sheet cần điền dữ liệu sang.
Mã: 
With Sheets("Ten")
Nên nếu em muốn thêm một "cặp" sheet là shee "D" và sheet "E"
Sheet cần lấy dữ liều là "D" và dữ liệu được lấy sang sheet"E"
Thì phải thêm một mudule mới, chép đoạn code anh giúp vào và chỉnh sửa code như thế nào vậy anh?
Những ô trong "E" tô nền vàng là những ô được lấy dữ liệu liên kết từ "D" sang khi Spin.
Code em đăng bài 1 khi in có sử dụng kết hợp với hàm Vlookup(), lấy dữ liệu từ vùng Vlookup().
Anh xem giúp em.
View attachment 227975
View attachment 227976
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Rectangle1_E()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:K" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("D5").Value = sArr(i, 1)
    Range("E6").Value = sArr(i, 4)
    Range("F6").Value = sArr(i, 5)
    Range("E7").Value = sArr(i, 6)
    Range("F7").Value = sArr(i, 7)
    Range("E8").Value = sArr(i, 8)
    Range("F8").Value = sArr(i, 9)
    Range("D2:F15").PrintPreview ' Xem truoc khi in
    'Range("D2:F15").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub Rectangle2_E()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:k" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("D5").Value = sArr(ik, 1)
        Range("E6").Value = sArr(ik, 4)
        Range("F6").Value = sArr(ik, 5)
        Range("E7").Value = sArr(ik, 6)
        Range("F7").Value = sArr(ik, 7)
        Range("E8").Value = sArr(ik, 8)
        Range("F8").Value = sArr(ik, 9)
        
        Range("D2:F15").PrintPreview ' Xem truoc khi in
        'Range("D2:F15").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
 

File đính kèm

vc_đi chơi đã viết:
File đã giúp em ở bài #15 có 03 module và 01 Form em đã copy cả vào rồi đó ạ:
Module11 ( trùng với module1 sẵn có nên đối thành Module11), module Muousemove, Fun_Filter2Array
Form_Printts.
Không hiểu sao ạ!
Nhấp chuột vào đây để mở rộng...
Cái này gọi là thừa chứ không thiếu rồi (Có 2 cái giống chỉ khác tên Module )
 

File đính kèm

HieuCD đã viết:
Mã: 
Sub Rectangle1_E()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:K" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("D5").Value = sArr(i, 1)
    Range("E6").Value = sArr(i, 4)
    Range("F6").Value = sArr(i, 5)
    Range("E7").Value = sArr(i, 6)
    Range("F7").Value = sArr(i, 7)
    Range("E8").Value = sArr(i, 8)
    Range("F8").Value = sArr(i, 9)
    Range("D2:F15").PrintPreview ' Xem truoc khi in
    'Range("D2:F15").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub Rectangle2_E()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:k" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("D5").Value = sArr(ik, 1)
        Range("E6").Value = sArr(ik, 4)
        Range("F6").Value = sArr(ik, 5)
        Range("E7").Value = sArr(ik, 6)
        Range("F7").Value = sArr(ik, 7)
        Range("E8").Value = sArr(ik, 8)
        Range("F8").Value = sArr(ik, 9)
       
        Range("D2:F15").PrintPreview ' Xem truoc khi in
        'Range("D2:F15").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn anh nhiều!

HieuCD đã viết:
Mã: 
Sub Rectangle1_E()
  Dim sArr(), eRow&, fRow&, sRow&, i&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:K" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  fRow = Range("B2").Value
  If fRow < 1 Then fRow = 1
  eRow = Range("C2").Value
  If eRow > sRow Then eRow = sRow
  For i = fRow To eRow
    Range("D5").Value = sArr(i, 1)
    Range("E6").Value = sArr(i, 4)
    Range("F6").Value = sArr(i, 5)
    Range("E7").Value = sArr(i, 6)
    Range("F7").Value = sArr(i, 7)
    Range("E8").Value = sArr(i, 8)
    Range("F8").Value = sArr(i, 9)
    Range("D2:F15").PrintPreview ' Xem truoc khi in
    'Range("D2:F15").PrintOut 'In
    strRes = strRes & "," & i
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub

Sub Rectangle2_E()
  Dim sArr(), S, eRow&, N, sRow&, i&, ik&, strRes$
  With Sheets("D")
    eRow = .Range("B" & Rows.Count).End(xlUp).Row
    If eRow < 5 Then MsgBox ("Khong co du lieu"): Exit Sub
    sArr = .Range("C6:k" & eRow).Value
  End With
  sRow = UBound(sArr)
  On Error Resume Next
  strRes = Range("B4").Value
  S = Split("," & strRes, ",")
  strRes = ""
  N = UBound(S)
  For i = 1 To N
    If IsNumeric(S(i)) Then
      ik = CLng(S(i))
      If ik > 0 And ik <= sRow Then
        Range("D5").Value = sArr(ik, 1)
        Range("E6").Value = sArr(ik, 4)
        Range("F6").Value = sArr(ik, 5)
        Range("E7").Value = sArr(ik, 6)
        Range("F7").Value = sArr(ik, 7)
        Range("E8").Value = sArr(ik, 8)
        Range("F8").Value = sArr(ik, 9)
       
        Range("D2:F15").PrintPreview ' Xem truoc khi in
        'Range("D2:F15").PrintOut 'In
        strRes = strRes & "," & ik
      End If
    End If
  Next i
  If Len(strRes) Then
    MsgBox ("Da in cac So thu tu: " & Mid(strRes, 2, Len(strRes)))
  Else
    MsgBox ("Du lieu So Thu Tu khong phu hop, Khong In")
  End If
End Sub
Nhấp chuột vào đây để mở rộng...
Vậy là mỗi cặp sheet tạo thêm một hai sub nữa phải không anh?
 
Nhất Chi Lan đã viết:
Cái này gọi là thừa chứ không thiếu rồi (Có 2 cái giống chỉ khác tên Module )
Nhấp chuột vào đây để mở rộng...
Anh cho em hỏi em thêm một maccro để tự động hiện dòng khi thêm dữ liệu và ẩn dòng khi dữ liệu là trống.
Thì cần thêm macro vào đâu trong code anh đã giúp để mỗi khi in có thể tự động chèn dòng khi dữ liệu được lấy sang và ẩn dòng khi dữ liệu trống.
Maccro em như sau:
Mã: 
Sub Macro5()
    ActiveSheet.Range("$E$5:$E$8").AutoFilter Field:=1, Criteria1:="H"
End Sub
Em đã thêm code trên vào Viewcode > Form_Printts nhưng vẫn không được.

an.png
 

File đính kèm

Lần chỉnh sửa cuối:
vc_đi chơi đã viết:
Anh cho em hỏi em thêm một maccro để tự động hiện dòng khi thêm dữ liệu và ẩn dòng khi dữ liệu là trống.
Thì cần thêm macro vào đâu trong code anh đã giúp để mỗi khi in có thể tự động chèn dòng khi dữ liệu được lấy sang và ẩn dòng khi dữ liệu trống.
Maccro em như sau:
Mã: 
Sub Macro5()
    ActiveSheet.Range("$E$5:$E$8").AutoFilter Field:=1, Criteria1:="H"
End Sub
Em đã thêm code trên vào Viewcode > Form_Printts nhưng vẫn không được.

View attachment 228460
Nhấp chuột vào đây để mở rộng...
Anh HieuCD giúp em mới nhé!
 
vc_đi chơi đã viết:
Anh cho em hỏi em thêm một maccro để tự động hiện dòng khi thêm dữ liệu và ẩn dòng khi dữ liệu là trống.
Thì cần thêm macro vào đâu trong code anh đã giúp để mỗi khi in có thể tự động chèn dòng khi dữ liệu được lấy sang và ẩn dòng khi dữ liệu trống.
Maccro em như sau:
Mã: 
Sub Macro5()
    ActiveSheet.Range("$E$5:$E$8").AutoFilter Field:=1, Criteria1:="H"
End Sub
Em đã thêm code trên vào Viewcode > Form_Printts nhưng vẫn không được.

View attachment 228460
Nhấp chuột vào đây để mở rộng...
Khỏi cần code và lọc dữ liệu, chỉ cần Format theo điều kiện
 

File đính kèm

HieuCD đã viết:
Khỏi cần code và lọc dữ liệu, chỉ cần Format theo điều kiện
Nhấp chuột vào đây để mở rộng...
Mất bo viền dưới cùng anh ạ!
Anh cho em hỏi giả sử thêm code trên vào để khi in (bài #26) tự động ẩn/hiện dòng trống thì thêm đoạn code em nêu trên vào phần nào vậy ạ? anh giúp em nhé! để em áp dụng cho lần sau.
Anh xem giúp em mới nhé! cám ơn anh!ggggggggggg.png
 
vc_đi chơi đã viết:
Anh cho em hỏi em thêm một maccro để tự động hiện dòng khi thêm dữ liệu và ẩn dòng khi dữ liệu là trống.
Thì cần thêm macro vào đâu trong code anh đã giúp để mỗi khi in có thể tự động chèn dòng khi dữ liệu được lấy sang và ẩn dòng khi dữ liệu trống.
Maccro em như sau:
Mã: 
Sub Macro5()
    ActiveSheet.Range("$E$5:$E$8").AutoFilter Field:=1, Criteria1:="H"
End Sub
Em đã thêm code trên vào Viewcode > Form_Printts nhưng vẫn không được.

View attachment 228460
Nhấp chuột vào đây để mở rộng...
Bạn phải giải thích cách nhập dữ liệu vào Form, các thao tác từng bước, mình mới dò các dòng lệnh trong Form và thêm lệnh mới định dạng lại vùng in được
 
vc_đi chơi đã viết:
Mất bo viền dưới cùng anh ạ!
Anh cho em hỏi giả sử thêm code trên vào để khi in (bài #26) tự động ẩn/hiện dòng trống thì thêm đoạn code em nêu trên vào phần nào vậy ạ? anh giúp em nhé! để em áp dụng cho lần sau.
Anh xem giúp em mới nhé! cám ơn anh!View attachment 228475
Nhấp chuột vào đây để mở rộng...
File trên máy mình không bị mất, bản có chỉnh gì không?
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

V
Quản lý xuất nhập vật tư trong kho (4 người xem)
Trả lời
16
Đọc
622
Vũ Hải Sơn
V
H
Đánh số thự theo lượt (1 người xem)
Trả lời
5
Đọc
95
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (2 người xem)
Trả lời
2
Đọc
148
danhpheo
D
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
2
Đọc
147
phuongnam366377
phuongnam366377
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show
Trả lời
2
Đọc
111
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
5
Đọc
170
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
119
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
307
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
166
eagle12
E
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
436
Đọc
57K
hangiang
H
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
410
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
105
Nam168
Nam168
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
122
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
6
Đọc
326
Chả_biết_gì
C
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
26
Đọc
1K
haitien123
H
ongke0711
Truy cập trang GPE chậm
    • Thích
Trả lời
3
Đọc
239
Hai Lúa Miền Tây
Hai Lúa Miền Tây
V
Gộp File Từng File Excel vào 1 File
Trả lời
16
Đọc
551
ptm0412
ptm0412
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom