Snasui Excel Forum

Code: Select all

Sub PrintOutput()
Dim i As Integer
Dim a As Integer
Dim v As Integer
On Error Resume Next
v = InputBox(Title:="StartNo.", prompt:="InputStartNo.")
a = InputBox(Title:="EndNo.", prompt:="InputEndNo.")
If Err = 13 Then
MsgBox "InputStartNo. to InputEndNo. "
Exit Sub
End If
For i = v To a
Range("a2") = i
Range("a2").NumberFormat = "000"
'Range("a1:al24").PrintOut
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Range("E4") & "\" & Range("E5").Value & "-" & Range("E6").Value & ".pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
   MsgBox "Finish"
End Sub

Code: Select all

Sub PrintOutput()
    Dim i As Integer
    Dim a As Integer
    Dim v As Integer
    Dim x As Long
    Dim nb As Workbook
    On Error Resume Next
    v = InputBox(Title:="StartNo.", prompt:="InputStartNo.")
    a = InputBox(Title:="EndNo.", prompt:="InputEndNo.")
    If Err = 13 Then
        MsgBox "InputStartNo. to InputEndNo. "
        Exit Sub
    End If
    x = 15
    Range("a17:h" & Rows.Count).Clear
    For i = v To a
        Range("a2") = i
        Range("a2").NumberFormat = "000"
        'Range("a1:al24").PrintOut
        Range("a2:h15").Copy
        Range("a2").Offset(x, 0).PasteSpecial xlPasteValues
        Range("a2").Offset(x, 0).PasteSpecial xlPasteFormats
        x = x + 15
    Next i
    Set nb = Workbooks.Add
    ThisWorkbook.Activate
    Range("a17", Selection).Copy
    With nb
        .Sheets(1).Paste
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = 100
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\Data" & v & "_" & a & ".pdf", Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        .Close False
    End With
    Application.CutCopyMode = False
    MsgBox "Finish"
End Sub

Code: Select all

Sub PrintOutput()
    Dim i As Integer
    Dim a As Integer
    Dim v As Integer
    Dim x As Long
    Dim nb As Workbook
    On Error Resume Next
    v = InputBox(Title:="StartNo.", prompt:="InputStartNo.")
    a = InputBox(Title:="EndNo.", prompt:="InputEndNo.")
    If Err = 13 Then
        MsgBox "InputStartNo. to InputEndNo. "
        Exit Sub
    End If
    x = 31
    Range("a33:h" & Rows.Count).Clear
    For i = v To a
        Range("a2") = i
        Range("a2").NumberFormat = "000"
        'Range("a1:al24").PrintOut
        Range("a2:h32").Copy
        Range("a2").Offset(x, 0).PasteSpecial xlPasteValues
        Range("a2").Offset(x, 0).PasteSpecial xlPasteFormats
        x = x + 30
    Next i
    Set nb = Workbooks.Add
    ThisWorkbook.Activate
    Range("a33", Selection).Copy
    With nb
        .Sheets(1).Paste
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = 100
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\Data" & v & "_" & a & ".pdf", Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        .Close False
    End With
    Application.CutCopyMode = False
    MsgBox "Finish"
End Sub