Excel Forum

Code: Select all

Sub พิมพ์ใบรับจ่ายAPP()
Application.ScreenUpdating = False

Set rg = Range("R1")
rg.Activate
If Application.CountA(Range("H1")) = 0 Then
   MsgBox "ใส่ผู้จัดทำด้วยครับ", vbCritical
   Exit Sub
End If
rg.Activate
If Application.CountA(Range("F3")) = 0 Then
    MsgBox "ใส่ สาเหตุ ด้วยครับ", vbCritical
    Exit Sub
End If


Dim x As Integer
    x = MsgBox("ตรวจสอบข้อมูลแล้ว ใช่หรือไม่", vbOKCancel)
    If x = vbCancel Then
        Sheets("Sheet1").Select
   Else

Application.Calculation = xlCalculationManual
ActiveSheet.Unprotect Password:="1234"
    'print
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$32"
   Application.ActivePrinter = "EPSON L360 Series on Ne03:"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
          "EPSON L360 Series on Ne03:", Collate:=True, IgnorePrintAreas:=False
    
      'บันทึก AppTotal
      If Range("A3") = "" Then
      Else
     Application.Goto Reference:="OFFSET(R3C1,0,0,1,6)"
    Selection.Copy
    Workbooks("AppTotal.xlsx").Activate
    Sheets("Sheet1").Select
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1),0)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
   ThisWorkbook.Activate
   If Range("A4") = "" Then
      Else
     Application.Goto Reference:="OFFSET(R3C1,0,0,1,6)"
    Selection.Copy
    Workbooks("AppTotal.xlsx").Activate
    Sheets("Sheet1").Select
    Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1),0)"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
   End If
    Range("A3:A32,F3:F32,H1").Select
    Selection.ClearContents
    Range("A3").Select
    ActiveSheet.Protect Password:="1234"
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.Activate
   
   End If
End Sub

Code: Select all

Sub พิมพ์ใบรับจ่ายAPP()
    Application.ScreenUpdating = False
    
    Set rg = Range("R1")
    rg.Activate
    If Application.CountA(Range("H1")) = 0 Then
        MsgBox "ใส่ผู้จัดทำด้วยครับ", vbCritical
        Exit Sub
    End If
    rg.Activate
    If Application.CountA(Range("F3")) = 0 Then
        MsgBox "ใส่ สาเหตุ ด้วยครับ", vbCritical
        Exit Sub
    End If
    
    
    Dim x As Integer
    x = MsgBox("ตรวจสอบข้อมูลแล้ว ใช่หรือไม่", vbOKCancel)
    If x = vbCancel Then
        Sheets("Sheet1").Select
    Else
    
    Application.Calculation = xlCalculationManual
    ActiveSheet.Unprotect Password:="1234"
    'print
    ActiveSheet.PageSetup.PrintArea = "$A$1:$H$32"
    Application.ActivePrinter = "EPSON L360 Series on Ne03:"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
    "EPSON L360 Series on Ne03:", Collate:=True, IgnorePrintAreas:=False
    
    'บันทึก AppTotal
    If Range("A3") = "" Then
    Else
        With Worksheets("Sheet1")
            .Range("a3", .Range("a" & .Rows.Count).End(xlUp)).Resize(, 6).Copy
        End With
        With Workbooks("AppTotal.xlsx").Worksheets("Sheet1")
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues
        End With
'        Application.Goto Reference:="OFFSET(R3C1,0,0,1,6)"
'        Selection.Copy
'        Workbooks("AppTotal.xlsx").Activate
'        Sheets("Sheet1").Select
'        Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1),0)"
'        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'            :=False, Transpose:=False
        Application.CutCopyMode = False
'    End If
'    ThisWorkbook.Activate
'    If Range("A4") = "" Then
'    Else
'        Application.Goto Reference:="OFFSET(R3C1,0,0,1,6)"
'        Selection.Copy
'        Workbooks("AppTotal.xlsx").Activate
'        Sheets("Sheet1").Select
'        Application.Goto Reference:="OFFSET(R1C1,COUNTA(C1),0)"
'        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'            :=False, Transpose:=False
'        Application.CutCopyMode = False
'    End If
    Range("A3:A32,F3:F32,H1").Select
    Selection.ClearContents
    Range("A3").Select
    ActiveSheet.Protect Password:="1234"
    Application.Calculation = xlCalculationAutomatic
    ThisWorkbook.Activate
    End If
End Sub