Thema: Rechnung mit Überträgen

StandardModule: basMain

Sub RechnungSchreiben()
   Dim wksSource As Worksheet, wksSecond As Worksheet
   Dim dValue As Double
   Dim iRowL As Integer, iPrint As Integer, iCount As Integer
   Dim iPage As Integer
   Set wksSource = Worksheets("Eingabe")
   Set wksSecond = Worksheets("RechnungFF")
   Range("A29:G54").ClearContents
   iRowL = wksSource.Cells(Rows.Count, 1).End(xlUp).Row
   Range("A29:A54").Value = wksSource.Range("A2:A27").Value
   Range("F29:F54").Value = wksSource.Range("C2:C27").Value
   Range("G29:G54").Value = wksSource.Range("B2:B27").Value
   If iRowL < 27 Then
      Call SetBottom(ActiveSheet, True)
      ActiveSheet.PrintPreview
   Else
      Call SetBottom(ActiveSheet, False)
      ActiveSheet.PrintPreview
      dValue = Range("H55").Value
      iPage = 1
      For iPrint = 28 To iRowL Step 47
         With wksSecond
            .Range("A6, A8:G53, H7").ClearContents
            If iPrint + 47 <= iRowL Then
               Call SetBottom(wksSecond, False)
            Else
               Call SetBottom(wksSecond, True)
            End If
            iPage = iPage + 1
            .Range("A6").Value = "Blatt " & iPage & _
               " von " & Range("D26").Value
            .Range("H7").Value = dValue
            .Range("A8:A54").Value = wksSource.Range( _
               "A" & iPrint & ":A" & iPrint + 46).Value
            .Range("F8:F54").Value = wksSource.Range( _
               "C" & iPrint & ":C" & iPrint + 46).Value
            .Range("G8:G54").Value = wksSource.Range( _
               "B" & iPrint & ":B" & iPrint + 46).Value
            .PrintPreview
            dValue = .Range("H55").Value
         End With
      Next iPrint
   End If
End Sub

Private Sub SetBottom(wks As Worksheet, bln As Boolean)
   If bln Then
      wks.Range("A55").Value = "Nettobetrag:"
      wks.Range("A56").Value = "Mwst.:"
      wks.Range("A57").Value = "Rechnungsbetrag:"
      wks.Range("G56").Value = Worksheets("Data").Range("Mwst").Value
      wks.Range("H56").FormulaR1C1 = "=R[-1]C*RC[-1]"
      wks.Range("H57").FormulaR1C1 = "=R[-2]C+R[-1]C"
      With wks.Range("A57:H57")
         .Borders(xlEdgeTop).Weight = xlThin
         .Borders(xlEdgeBottom).LineStyle = xlDouble
      End With
   Else
      wks.Range("A55").Value = "Übertrag:"
      With wks.Range("A56:H57")
         .ClearContents
         .Borders.LineStyle = xlLineStyleNone
      End With
   End If
End Sub

Beiträge aus dem Excel-Forum zu den Themen Druck und Zwischensumme