NHờ ACE sửa code in 2 HĐ trên 1 trang giấy A4.

[vu_ctn]

Như tiêu đề mình đã nói , mình có 1 code in hóa đơn, nhưng mình in trên khổ giấy A4 chứ không in trên giấy in liên tục, nên mình muốn 1 lần in đc 2 hóa đơn cùng 1 lúc ( nhưng phải liền kề nhau). MÌnh nghiêng cứu hoài kg đc. Các ACE cao thủ xem file đính kèm và giúp mình nhe . Thank các ACE trước.

 

[ptm0412]

Bạn thử đánh công thức cho AK31: =AK4 xem? Có phải bạn muốn vậy không?

 

[ptm0412]

Nếu không phải bạn muốn in 2 liên hóa đơn cùng số mà là in 2 hóa đơn khác số thì sửa code như sau, nhớ sửa những Vlookup(AK4, ...) ở hóa đơn dưới thành Vlookup(AK31, ...):

Sub InPhieu()
Dim rng As Range, Arr, i As Long,Cll

Set rng = Application.InputBox( _
"Vui long quet chon vung co MS KHACH HANG can in " & _
    vbNewLine & vbNewLine & vbNewLine & _
    vbNewLine & "cot B Sheet DANHSACH  ", "Chon ma so khach hang", Type:=8)

If Not rng Is Nothing Then
ReDim Arr(1 To rng.Count)
  For Each Cll In rng
  i = i + 1
  Arr(i) = Cll.Value
  Next
  For i = 1 To rng.Count Step 2
    [AK4] = Arr(i)
    [ak31] = Arr(i + 1)

    ActiveWindow.SelectedSheets.PrintPreview
  Next
Else
  MsgBox "Ban da khong chon in"
End If
End Sub

 

[vu_ctn]

Cảm ơn bạn ptm0412 đã nhiệt tình giúp đỡ mình giải quyết vấn đề, nhưng khi mình in lại gặp sự cố :
- Nếu mình in số HĐ chẵn ( 2,4,6..) thì code chạy tốt.
- Nếu mình in số HĐ lẽ ( 1,3,5...) thì code lại báo lỗi ngay dòng [ak31] = Arr(i + 1)
Bạn có thể giúp mình sửa thêm lỗi này đc kg. Cảm ơn bạn 1 lần nữa.

 

[ptm0412]

Sửa lại thành:

[ak31] = IIf(i = rng.Count, 0, Arr(i + 1))

Nửa dưới trang in cuối sẽ bị toàn là #N/A, cắt bỏ đi. Hoặc khi in tờ cuối, bỏ tờ A5 vô.

 

[vu_ctn]

Vẫn kg đc bạn ơi, mình đã thay dòng [ak31] = Arr(i + 1) thành
[ak31] = IIf(i = rng.Count, 0, Arr(i + 1))
nhưng kêt quả vẫn báo lỗi.
Bạn xem lại dùm mình nhe.

 

[ptm0412]

Vậy thay [ak31] = Arr(i + 1) bằng nguyên đoạn sau:

    If i = rng.Count Then
        [ak31] = 0
    Else
        [ak31] = Arr(i + 1)
    End If

IIf của VBA không giống If của Excel Functions: If của Excel Functions hễ thấy True thì không xét False, còn IIf thì cứ xét, nên thấy i + 1 vượt quá giới hạn mảng.
Ghi chú: Code này có thể in nếu các số hóa đơn được chọn không liên tục (chọn nhiều vùng không liên tục bằng cách nhấn Ctrl)

Hoặc để nguyên [ak31] = Arr(i + 1) nhưng thay câu

ReDim Arr(1 To rng.Count)

bằng

ReDim Arr(1 To rng.Count [COLOR=red]+ 1[/COLOR])

 

[sealand]

Mình tham gia Code in như sau

Option Explicit
Sub InPhieu()
  Dim rng As Range, Cls As Range, i, DS()
   On Error Resume Next
    Set rng = Application.InputBox( _
     "Vui long quet chon vung co MS KHACH HANG can in " & _
      vbNewLine & vbNewLine & vbNewLine & _
       vbNewLine & "cot B Sheet DANHSACH  ", "Chon ma so khach hang", Type:=8)
         On Error GoTo 0
            If Not rng Is Nothing Then
             With Sheet6
              For i = 1 To rng.Cells.Count + 1 Step 2
            .[AK4] = rng.Cells(i)
           [AK31] = IIf(i + 1 < rng.Cells.Count + 1, rng.Cells(i + 1), 0)
          chuyen
        .PrintPreview
      Next
     End With
    Else
  MsgBox "Ban da khong chon in"
 End If
End Sub
'=========================
Sub chuyen()
 With Sheet6
  If .[AK31] = 0 Then
   .Shapes("Ky3").Top = .Shapes("Ky1").Top
    .Shapes("Ky3").Left = .Shapes("Ky1").Left
     .Shapes("Ky4").Top = .Shapes("Ky2").Top
      .Shapes("Ky4").Left = .Shapes("Ky2").Left
        Else
      .Shapes("Ky3").Top = .[D44].Top
    .Shapes("Ky3").Left = .[D44].Left
   .Shapes("Ky4").Top = .[V44].Top
  .Shapes("Ky4").Left = .[V44].Left
  End If
 End With

 

[ptm0412]

Code của Sealand:

1. Khi chọn in các vùng không liên tục thí dụ in các hoá đơn (001, 002,003) và (011, 012, 013), kết quả in không theo ý muốn mà là in từ 001 đến 006.

2. Khi chọn in 1 số chẵn các hoá đơn, luôn luôn bị dư 1 hoá đơn. Như vậy theo câu (1) thì sẽ in từ 001 đến 007)

3. Code chuyen() có thể làm ngắn gọn như sau:

Sub HideShapes()
 With Sheet6
    .Shapes("Ky3").Visible = (.[AK31] <> 0)
    .Shapes("Ky4").Visible = (.[AK31] <> 0)
 End With
End Sub

 

[sealand]

Anh Mỹ à, ban đầu em cũng dùng Visiable không hiểu sao nó cứ vẫn lòi đầu lên, anh test lại giùm nha). Sau em chơi bài nếu ô AK31=0 ẩn từ dòng 29 đến dòng 54 nhưng không hểu sao nó cũng cứ chui ra ngoài. Vậy là em dùng chiêu cần ẩn thì chồng 2 cái làm 1.
Đúng là em chỉ sử lý để in liên tục thôi chứ chưa sử lý đa vùng và khi hóa đơn không tiền.
Lưu ý Code gốc viết cho việc in 2 liên HD nên để nguyên dòng lệnh ẩn HĐ không tiền cũ là dễ mất tiêu HD cùng trang.

 

[ptm0412]

Sealand xem file, khi số hoá đơn in lẻ, sẽ hide mấy chữ ký ở nửa đưới trang cuối.
Ngoài ra, có thể chọn nhiều vùng in cách quãng.

 

[vu_ctn]

Các vấn đè mình đưa ra bạn Ptm0412 và Sealand đã giải quyết xong. Thank 2 bạn rất nhiều.
Sẵn có 2 cao thủ ghé thăm đề tài cảu mình, mình xin mạng phép nhờ 2 bạn chỉnh code file in của mình nhìn chuyên nghiệp hơn 1 tí.
+ khi chạy macrro InPhieu ta không chọn vùng in (tức bấm Cancel) macrro báo lỗi giá trị nhập vào. Các bạn có thể sửa dùm mình lỗi này đc kg?
+ Khi chọn vùng in macrro sẽ đếm số phiếu đã chọn in ( vd : in 3 hđ macrro sẽ hiện ra thông báo : Tổng số HD là 03)

 

[vu_ctn]

Các bạn cao thủ có thể nghiêng cứu giúp mình hoặc chỉ mình hướng giai quyết đc hem. Mình làm hoài kg đc.

 

[ptm0412]

Sub InPhieu()
Dim rng As Range, Arr, i As Long, Cll, Sure
On Error GoTo Error1
Set rng = Application.InputBox( _
"Vui long quet chon vung co MS KHACH HANG can in " & _
    vbNewLine & vbNewLine & vbNewLine & _
    vbNewLine & "cot B Sheet DANHSACH  ", "Chon ma so khach hang", Type:=8)

Sure = MsgBox("Ban co muon in " & rng.Count & " hoa don khong?", vbYesNo, "Are you sure?")
If Sure = vbYes Then
ReDim Arr(1 To rng.Count + 1)
  For Each Cll In rng
  i = i + 1
  Arr(i) = Cll.Value
  Next
  For i = 1 To rng.Count Step 2
    [AK4] = Arr(i)
    [AK31] = Arr(i + 1)
    HideShapes
    ActiveSheet.PrintPreview
  Next
  MsgBox "Ban da in " & rng.Count & " hoa don"
Else
GoTo Error1
End If
  Exit Sub
Error1:
  MsgBox "Ban da khong chon in"

End Sub

 

[vu_ctn]

Thank bạn Ptm0412 đoạn code bạn post lên đã giải quyết đc yêu cầu của mình 100% rồi.Thank bạn nhiều. khi sử dụng có thắc mặc gì mình sẽ hỏi tiếp.