Nhờ mọi người viết code in sổ thu chi (2 người xem)

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

hongtu1803

Thành viên chính thức
Tham gia
1/2/13
Bài viết
69
Được thích
15
Nghề nghiệp
Luật sư
Nhờ mọi người viết code in sổ thu chi.
Kết quả & các yêu cầu tôi đã nêu rõ trong file đính kèm.
Cảm ơn!
 

File đính kèm

Lần chỉnh sửa cuối:
Cảm ơn bác. Như vậy là ổn rồi.
 
Upvote 0
Nhờ bác Ba Tê giúp thêm cái phần in.
Trong file đính kèm, sheet "So", tôi muốn set print area từ A -> G (từ A1 đến dòng cuối cùng vùng dữ liệu).
Tôi thử mãi, nhưng chưa xong, mong bác giúp.
 

File đính kèm

Upvote 0
Nhờ bác Ba Tê giúp thêm cái phần in.
Trong file đính kèm, sheet "So", tôi muốn set print area từ A -> G (từ A1 đến dòng cuối cùng vùng dữ liệu).
Tôi thử mãi, nhưng chưa xong, mong bác giúp.
Tạo một nút gì đó, gán Sub này cho nó rồi bấm thử xem. Tôi hết giấy in rồi.
PHP:
Sub IN_GPE()
Dim R As Long
With Sheets("So")
    R = .Range("B65536").End(xlUp).Row
    .Range("A1:G" & R).PrintOut Copies:=1
End With
End Sub
 
Upvote 0
Tạo một nút gì đó, gán Sub này cho nó rồi bấm thử xem. Tôi hết giấy in rồi.
PHP:
Sub IN_GPE()
Dim R As Long
With Sheets("So")
    R = .Range("B65536").End(xlUp).Row
    .Range("A1:G" & R).PrintOut Copies:=1
End With
End Sub
Trong sheet "So" đã có nút GPE rồi, bác tích hợp vào đó luôn giùm (chọn vùng dữ liệu in từ A1 đến dưới tên của giám đốc)
 
Upvote 0
- Cứ theo Thầy Ba Tê mà học he he. Giá mà nắm được thì mình cũng Thấy khỏe đó bạn ạ!.
- Bạn sửa Code của Thầy như sau xem sao?

Mã:
Public Sub LOC_TK()Dim sArr(), dArr(), I As Long, J As Long, K As Long, TK As Long, Col As Long, Ton As Double, Sh As String, R As Long
Dim Str1 As String, Str2 As String, Str3 As String, Str4 As String, Str5 As String, Str6 As String
Sh = [H1].Value
With Sheets(Sh)
    sArr = .Range(.[A4], .[A4].End(xlDown)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
With Sheets("So")
    TK = .Range("E2").Value
    Ton = .[G4].Value
    Str1 = .[L1].Value: Str2 = .[L2].Value
    Str3 = .[L3].Value: Str4 = .[L4].Value
    Str5 = .[L5].Value: Str6 = .[L6].Value
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 6) = TK Or sArr(I, 7) = TK Then
            K = K + 1
            Col = IIf(sArr(I, 6) = TK, 5, 6)
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
            dArr(K, Col) = sArr(I, 8)
            dArr(K, 7) = Ton + dArr(K, 5) - dArr(K, 6)
            Ton = dArr(K, 7)
        End If
    Next I
    .[A7:H1000].ClearContents
    .[A7:H1000].Borders.LineStyle = xlNone
    .[A7:H1000].Font.Bold = False
    .[F7:F1000].HorizontalAlignment = xlGeneral
    If K Then
        .[A7].Resize(K, 7) = dArr
        .[A7].Resize(K + 1, 7).Borders.LineStyle = xlContinuous
        .[A7].Resize(K, 7).Borders(xlInsideHorizontal).Weight = xlHairline
        .[D7].Offset(K) = Str1
        .[F7].Offset(K + 2) = Str3
        .[D7].Offset(K).Resize(, 4).Font.Bold = True
        .[E7:F7].Offset(K) = "=SUM(R7C:R[-1]C)"
        .[G7].Offset(K) = "=R4C+RC[-2]-RC[-1]"
        .[B7].Offset(K + 3) = Str2
        .[B7].Offset(K + 8) = Str5
        .[F7].Offset(K + 3) = Str4
        .[F7].Offset(K + 8) = Str6
        .[F7].Offset(K + 2).Resize(7).HorizontalAlignment = xlCenter
    Else
        MsgBox "Khong co du lieu!", , "GIAIPHAPEXCEL"
    End If
        R = .Range("B65536").End(xlUp).Row
    .Range("A1:G" & R).PrintOut Copies:=1
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
- Cứ theo Thầy Ba Tê mà học he he. Giá mà nắm được thì mình cũng Thấy khỏe đó bạn ạ!.
- Bạn sửa Code của Thầy như sau xem sao?

Mã:
Public Sub LOC_TK()Dim sArr(), dArr(), I As Long, J As Long, K As Long, TK As Long, Col As Long, Ton As Double, Sh As String, R As Long
Dim Str1 As String, Str2 As String, Str3 As String, Str4 As String, Str5 As String, Str6 As String
Sh = [H1].Value
With Sheets(Sh)
    sArr = .Range(.[A4], .[A4].End(xlDown)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 7)
With Sheets("So")
    TK = .Range("E2").Value
    Ton = .[G4].Value
    Str1 = .[L1].Value: Str2 = .[L2].Value
    Str3 = .[L3].Value: Str4 = .[L4].Value
    Str5 = .[L5].Value: Str6 = .[L6].Value
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 6) = TK Or sArr(I, 7) = TK Then
            K = K + 1
            Col = IIf(sArr(I, 6) = TK, 5, 6)
            For J = 1 To 4
                dArr(K, J) = sArr(I, J)
            Next J
            dArr(K, Col) = sArr(I, 8)
            dArr(K, 7) = Ton + dArr(K, 5) - dArr(K, 6)
            Ton = dArr(K, 7)
        End If
    Next I
    .[A7:H1000].ClearContents
    .[A7:H1000].Borders.LineStyle = xlNone
    .[A7:H1000].Font.Bold = False
    .[F7:F1000].HorizontalAlignment = xlGeneral
    If K Then
        .[A7].Resize(K, 7) = dArr
        .[A7].Resize(K + 1, 7).Borders.LineStyle = xlContinuous
        .[A7].Resize(K, 7).Borders(xlInsideHorizontal).Weight = xlHairline
        .[D7].Offset(K) = Str1
        .[F7].Offset(K + 2) = Str3
        .[D7].Offset(K).Resize(, 4).Font.Bold = True
        .[E7:F7].Offset(K) = "=SUM(R7C:R[-1]C)"
        .[G7].Offset(K) = "=R4C+RC[-2]-RC[-1]"
        .[B7].Offset(K + 3) = Str2
        .[B7].Offset(K + 8) = Str5
        .[F7].Offset(K + 3) = Str4
        .[F7].Offset(K + 8) = Str6
        .[F7].Offset(K + 2).Resize(7).HorizontalAlignment = xlCenter
    Else
        MsgBox "Khong co du lieu!", , "GIAIPHAPEXCEL"
    End If
        R = .Range("B65536").End(xlUp).Row
    .Range("A1:G" & R).PrintOut Copies:=1
End With
End Sub
Cảm ơn nhiều!
Nhưng mình chỉ muốn "set print area": nghĩa là định dạng vùng in dữ liệu thôi (A1 đến G??, cuối vùng dữ liệu), chứ không phải lệnh in trang (Vì phí bên phải sheet còn có nút "GPE" và 1 số dữ liệu sẽ không bao giờ in ra)
 
Upvote 0

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

Back
Top Bottom