Xin nhờ tạo UserForm in theo lựa chọn

Liên hệ QC
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

  • NB_2.xlsb
    31.1 KB · Đọc: 7
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

  • thu lai.xlsm
    118.4 KB · Đọc: 5
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

  • TB.xlsm
    111.8 KB · Đọc: 4
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

  • TB.xlsm
    112.7 KB · Đọc: 5
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.
Web KT

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

hung2412
Cần giải đáp: Sau khi Auto Fit dòng thì dòng nó không tự co lại
Trả lời
1
Đọc
20
quyenpv
quyenpv
H
  • Question
xin các thầy cho em xin bảng quy ước màu trong vba
Trả lời
15
Đọc
11K
meomap1904
meomap1904
C
Xin công thức xếp loại có điều kiện.
Trả lời
5
Đọc
182
VetMini
V
H
Nhờ gở rối công thức Averageif trong sheet summary
Trả lời
4
Đọc
48
Houserobot
H
trungvinh252
Xuất ngày tháng gần nhất được đánh dấu. Xin giúp đỡ ạ.
Trả lời
1
Đọc
96
HieuCD
H
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