Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As _
  System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
 
Dim acXPos As VariantType = 10
Dim acYPos As VariantType = 5
 
PrintDocument1.PrinterSettings.PrinterName = P5_CB_Druckerauswahl.Text
Dim MyFont14 As New System.Drawing.Font("Arial", 14, Drawing.FontStyle.Bold)
Dim MyFont12 As New System.Drawing.Font("Arial", 12, Drawing.FontStyle.Regular)
Dim MyFont10 As New System.Drawing.Font("Arial", 10, Drawing.FontStyle.Regular)
 
Dim MyDir As New System.IO.DirectoryInfo(DWGFile)
Dim MyFiles As System.IO.FileInfo() = MyDir.GetFiles("*.dwg")
Dim MyFile As System.IO.FileInfo
 
Dim gr As Graphics = e.Graphics
gr.PageUnit = GraphicsUnit.Millimeter
 
'...
'...
Dim i As Integer
 
Do While ParentFileName <> ""
    BasicFileName = ParentFileName.Remove(ParentFileName.Length - 6, 6)
    Dim BildName As String
    BildName = BasicFileName & "_D.wmf"
 
    Dim BlockBild As Bitmap = New Bitmap(ImportPfad & BildName)
    gr.DrawImage(BlockBild, acXPos, acYPos + 30)
 
    i = i + (BlockBild.Height * 2).ToString
 
    e.HasMorePages = (e.PageBounds.Height <= i + 50)
    Page += 1
 
    acYPos = acYPos + 60
    ParentFileName = Microsoft.VisualBasic.Dir()
Loop

mfg.

Dirk

mfg.

Dirk

Public Class frmPrintPictures
 
    Dim WithEvents pd As New Printing.PrintDocument
    Dim picindex As Integer
    Dim piclist As New List(Of Bitmap)
 
    Private Sub frmPrintPictures_Load(sender As System.Object, _
        e As System.EventArgs) Handles MyBase.Load
 
 
        Dim picfolder As String = _
        My.Computer.FileSystem.SpecialDirectories.MyPictures
 
        For Each picfile As String In IO.Directory.GetFiles(picfolder, "*.jpg")
            'Bild laden
            Dim bmpin As New Bitmap(picfile)
            'Thumbnail Size festlegen
            Dim width As Integer = 100
            Dim height As Integer = CInt(bmpin.Height * 100 / bmpin.Width)
            If height > 100 Then
                width = CInt(bmpin.Width * 100 / bmpin.Height)
                height = 100
            End If
 
            'Thumbnail erstellen und listen
            Dim bmp As New Bitmap(width, height)
            Using g As Graphics = Graphics.FromImage(bmp)
                g.DrawImage(bmpin, 0, 0, bmp.Width, bmp.Height)
                piclist.Add(bmp)
            End Using
        Next picfile
 
        'Drucken
        pd.Print()
    End Sub
 
    Private Sub pp_PrintPage(sender As Object, _
        e As System.Drawing.Printing.PrintPageEventArgs) Handles pd.PrintPage
 
        Dim ph As Integer = 0 'Position in y-Richtung
 
        Do While picindex < piclist.Count - 1 AndAlso _
            ph + piclist(picindex + 1).Height <= e.PageBounds.Height
            picindex += 1
            e.Graphics.DrawImage(piclist(picindex), 10, ph)
            ph += piclist(picindex).Height + 10
        Loop
 
        e.HasMorePages = picindex < piclist.Count - 1
    End Sub
End Class

Private aktuelleSeite As Integer
'...
Private Sub P5_CMB_Drucken_Click(sender As System.Object, e As _
  System.EventArgs) _
                                                    Handles P5_CMB_Drucken.Click
aktuelleSeite = 0
With PrintPreviewDialog1
    .Document = PrintDocument1
    If .ShowDialog() = System.Windows.Forms.DialogResult.OK Then
       PrintDocument1.Print()
    End If
End With
End Sub
 
Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As _       _
                       System.Drawing.Printing.PrintPageEventArgs) _
                            Handles PrintDocument1.PrintPage
 
 
       Dim gr As Graphics = e.Graphics
        gr.PageUnit = GraphicsUnit.Millimeter
        gr.PageScale = 1.0
 
        Dim acXPos As VariantType = 15
        Dim acYPos As VariantType = 5
 
        Dim ok As Bitmap = Me.ImageList1.Images(0)
        Dim no As Bitmap = Me.ImageList1.Images(1)
 
        Dim BildDir As New System.IO.DirectoryInfo(WMFFile)
        Dim BildFiles As System.IO.FileInfo() = BildDir.GetFiles("*_D.wmf")
        Dim BildFile As System.IO.FileInfo
 
        PrintDocument1.PrinterSettings.PrinterName = P5_CB_Druckerauswahl.Text
        Dim MyFont14 As New System.Drawing.Font("Arial", 14, _
          Drawing.FontStyle.Bold)
        Dim MyFont12 As New System.Drawing.Font("Arial", 12, _
        Drawing.FontStyle.Regular)
        Dim MyFont10 As New System.Drawing.Font("Arial", 10, _
        Drawing.FontStyle.Regular)
 
        Dim MyDir As New System.IO.DirectoryInfo(DWGFile)
        Dim MyFiles As System.IO.FileInfo() = MyDir.GetFiles("*.dwg")
        Dim MyFile As System.IO.FileInfo
 
        Dim MGruppe As String = Microsoft.VisualBasic.Right(DWGFile, 3)
 
        Try
            gr.DrawString(DWGFile, MyFont14, Brushes.Black, acXPos, acYPos)
            gr.DrawLine(Pens.Red, acXPos, acYPos + 12, acXPos + 190, acYPos + _
              12)
 
            gr.DrawString("Für die Materialgruppe - " & MGruppe & " - gibt es" & _
              "folgende Blöcke:", _                                             _
                   MyFont12, Brushes.Black, acXPos, acYPos + 20)
 
            'gr.DrawImage(BlockBild, acXPos, acYPos + 30)
            Dim ImportPfad As String
            ImportPfad = ALLPA_TB_Pfad.Text & "\"
            Dim DateiName As String
            DateiName = "*_D.dwg"
            Dim ParentFileName As String = Microsoft.VisualBasic.Dir(ImportPfad _
              & DateiName)
            Dim BasicFileName As String
 
            Dim fso As System.IO.File
 
            Dim wmfList As New List(Of Bitmap)
 
            Do While ParentFileName <> ""
 
                BasicFileName = ParentFileName.Remove(ParentFileName.Length - _
                  6, 6)
                Dim BildName As String
                BildName = BasicFileName & "_D.wmf"
 
                '--Bild einfügen---
                Dim BlockBild As Bitmap = New Bitmap(ImportPfad & BildName)
                wmfList.Add(BlockBild)
 
                gr.DrawImage(BlockBild, acXPos, acYPos + 30)
 
                '--Dateinamen _D.dwg einfügen--
                Dim FileName_D As String
                FileName_D = BasicFileName & "_D.dwg"
                gr.DrawString(FileName_D, MyFont10, Brushes.Black, acXPos + _
                  100, acYPos + 30)
                If fso.Exists(ImportPfad & FileName_D) Then
                    gr.DrawImage(ok, acXPos + 90, acYPos + 30)
                Else
                    gr.DrawImage(no, acXPos + 90, acYPos + 30)
                End If
 
'...
'...
                acYPos = acYPos + 70
                ParentFileName = Microsoft.VisualBasic.Dir()
            Loop
 
            e.HasMorePages = (aktuelleSeite < (wmfList.Count / 3))
            aktuelleSeite += 1
 
End Sub

mfg.

Dirk

    Dim importpfad As String = "C:\daten"
 
    Dim ParentFileNames As List(Of String) = _
          (IO.Directory.GetFiles(importpfad)).ToList
 
    Dim ParentFileIndex As Integer = -1
 
    Dim WithEvents prntdoc As New Printing.PrintDocument

    Private Sub prntdoc_PrintPage(sender As Object, _
        e As System.Drawing.Printing.PrintPageEventArgs) _
        Handles prntdoc.PrintPage
 
        Dim pageindex As Integer = 0
        Dim parentfilename As String
 
        Do While ParentFileIndex < ParentFileNames.Count - 1 And pageindex <3
            pageindex += 1
            ParentFileIndex += 1
            parentfilename = ParentFileNames(ParentFileIndex)
 
            'Hier dein Code zum Drucken der Bilder/Texte zur akt. Datei
 
        Loop
 
        e.HasMorePages = ParentFileIndex < ParentFileNames.Count - 1
    End Sub

'  Den Überschriftenblock festlegen 
' *************************************************
'  Blockverzeichnis
gr.DrawString(DWGFile, MyFont14, Brushes.Black, acXPos, acYPos)
'  Trennlinie
gr.DrawLine(Pens.Red, acXPos, acYPos + 12, acXPos + 190, acYPos + 12)
'  Materialgruppe filtern und drucken
Dim MGruppe As String = Microsoft.VisualBasic.Right(DWGFile, 3)
gr.DrawString("Für die Materialgruppe - " & MGruppe & " - gibt es folgende" & _
  "Blöcke:", MyFont12, Brushes.Black, acXPos, acYPos + 20)

e.HasMorePages = ParentFileIndex < ParentFileNames.Count - 1

'--global
Dim ParentFileIndex As Integer = -1
'...
Private Sub PrintDocument1_PrintPage(ByVal sender As System.Object, ByVal e As _
  System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
 
'  Drawing aktivieren 
' ***************************************************************
Dim gr As Graphics = e.Graphics
'...
'  Den Überschriftenblock festlegen 
' *************************************************
gr.DrawString(DWGFile, MyFont14, Brushes.Black, acXPos, acYPos)
'  Trennlinie
gr.DrawLine(Pens.Red, acXPos, acYPos + 12, acXPos + 190, acYPos + 12)
'...
Dim MyDir As New System.IO.DirectoryInfo(DWGFile)
Dim MyFiles As System.IO.FileInfo() = MyDir.GetFiles("*_D.dwg")
Dim MyFile As System.IO.FileInfo
'...
Dim ParentFileNames As List(Of String) = New List(Of String)
For Each MyFile In MyFiles
    ParentFileNames.Add(MyFile.Name)
Next
'...
Do While ParentFileIndex < ParentFileNames.Count - 1 And pageindex < 3
pageindex += 1
ParentFileIndex += 1
ParentFileName = ParentFileNames(ParentFileIndex)
 
'ab hier kommt der Druckblock sprich 3 je Seite
'dieses funktioniert auch.
'...
Loop
 
e.HasMorePages = ParentFileIndex < ParentFileNames.Count - 1
 
End Sub

mfg.

Dirk

Dim ParentFileNames As List(Of String) = New List(Of String)
Dim ParentFileIndex As Integer = -1
Dim WithEvents prntdoc As New Printing.PrintDocument
Dim ImportFile As String

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As _
  System.EventArgs) _
Handles MyBase.Load
'...
ImportFile = TextBox1.Text & "\"
End Sub

Private Sub ListenDruck()
    Dim myDir As New DirectoryInfo(ImportFile)
    Dim myFiles() As FileInfo
    myFiles = myDir.GetFiles("*.dwg")
 
    For Each MyFile In myFiles
        ParentFileNames.Add(MyFile.Name)
    Next
End Sub

Private Sub prntdoc_PrintPage(ByVal sender As System.Object, ByVal e As _
  System.Drawing.Printing.PrintPageEventArgs) Handles prntdoc.PrintPage
        Dim PositionX As Integer = e.MarginBounds.X * 25.4 \ 100 - 25
        Dim PositionY As Integer = e.MarginBounds.Y * 25.4 \ 100 - 25
        e.Graphics.PageUnit = GraphicsUnit.Millimeter
        Dim gr As Graphics = e.Graphics
 
        prntdoc.PrinterSettings.PrinterName = Me.P5_CB_Druckerauswahl.Text
 
        '  Startpositionen für X und Y festlegen 
        ' ********************************************
        Dim acXPos As VariantType = 15
        Dim acYPos As VariantType = 5
 
        '  Die Bitmaps für ok und no bestimmen 
        ' **********************************************
        Dim ok As Bitmap = Me.ImageList1.Images(0)
        Dim no As Bitmap = Me.ImageList1.Images(1)
 
        '  Die unterschiedlichen Schriftarten bzw. Höhen etc. definieren 
        ' ********************
        Dim MyFont14 As New System.Drawing.Font("Arial", 14, _
          Drawing.FontStyle.Bold)
        Dim MyFont12 As New System.Drawing.Font("Arial", 12, _
        Drawing.FontStyle.Regular)
        Dim MyFont10 As New System.Drawing.Font("Arial", 10, _
        Drawing.FontStyle.Regular)
 
        Dim fso As System.IO.File
 
        Dim pageindex As Integer = 0
        Dim parentfilename As String
 
        Do While ParentFileIndex < ParentFileNames.Count - 1 AndAlso pageindex < 3
            pageindex += 1
            ParentFileIndex += 1
            parentfilename = ParentFileNames(ParentFileIndex)
 
            Dim BasicFileName As String
 
            Label1.Text = ImportFile
 
            BasicFileName = parentfilename.Remove(parentfilename.Length - 6, 6)
            Dim BildName As String
            BildName = BasicFileName & "_D.wmf"
 
 
            '--Bild einfügen---
            Dim BlockBild As Bitmap = New Bitmap(ImportFile & BildName)
            gr.DrawImage(BlockBild, acXPos, acYPos + 30)
 
            '--Dateinamen _D.dwg einfügen--
            Dim FileName_D As String
            FileName_D = BasicFileName & "_D.dwg"
            gr.DrawString(FileName_D, MyFont10, Brushes.Black, acXPos + 100, _
              acYPos + 30)
            If fso.Exists(ImportFile & FileName_D) Then
                gr.DrawImage(ok, acXPos + 90, acYPos + 30)
            Else
                gr.DrawImage(no, acXPos + 90, acYPos + 30)
            End If
 
            '--Dateinamen _S.dwg einfügen--
            '...
            '--Dateinamen _F.dwg einfügen--
            '...
            '--Dateinamen _P.dwg einfügen--
            '...
        Loop
        e.HasMorePages = ParentFileIndex < ParentFileNames.Count - 1
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As _
      System.EventArgs) Handles Button1.Click
        Try
            ListenDruck()
            With PrintPreviewDialog1
                .Document = prntdoc
                If .ShowDialog() = System.Windows.Forms.DialogResult.OK Then
                    ParentFileIndex = -1
                    prntdoc.Print()
                End If
 
            End With
        Catch ex As System.Exception
            MsgBox("Problem:" & vbCrLf & ex.Message)
        End Try
    End Sub

mfg.

Dirk

Dim PositionX As Integer = e.MarginBounds.X * 25.4 \ 100 - 25
Dim PositionY As Integer = e.MarginBounds.Y * 25.4 \ 100 - 25

e.HasMorePages = ParentFileIndex < ParentFileNames.Count - 1

If Not e.HasMorePages Then ParentFileIndex = -1

Imports System.Drawing.Printing
 
Public Class Form1
 
    Dim abstand_x As Integer, abstand_y As Integer, seitenzahlen As Integer, _
      seitenzahl As Integer = 1, zähler As Integer = 0
    Dim arr As New List(Of String)
 
    Private WithEvents doc As New PrintDocument()
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As _
      System.EventArgs) Handles MyBase.Load
        abstand_x = 838
        abstand_y = 602
 
        For a As Integer = 0 To 300
            arr.Add(CStr(a))
        Next
 
        seitenzahlen = CInt(Math.Ceiling(arr.Count / 72))
 
    End Sub
 
    Private Sub Draw(ByVal g As Graphics, ByVal x As Integer, ByVal y As _
      Integer)
        Dim c As Color = Color.Black
        Dim f As Font = New Font(schriftart, schriftgröße)
 
        For i As Integer = zähler To arr.Count - 1
            If (i + 1) Mod 6 = 0 Then
                g.TextRenderingHint = _
                  Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
                g.DrawString(arr(i), f, New SolidBrush(c), New Point(x, y))
                x = 0 : y = CInt(y + abstand_y)
            Else
                g.TextRenderingHint = _
                  Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
                g.DrawString(arr(i), f, New SolidBrush(c), New Point(x, y))
                x = CInt(x + abstand_x)
            End If
            zähler += 1
            If (zähler Mod 72) = 0 Then Exit For
        Next
    End Sub
 
    Private Sub Drucker(ByVal sender As Object, ByVal e As PrintPageEventArgs) _
      Handles doc.PrintPage
        Dim g As Graphics = e.Graphics
        g.PageUnit = GraphicsUnit.Pixel
        g.TextRenderingHint = _
          Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
        Me.Draw(g, 0, 0)
        e.HasMorePages = seitenzahl < seitenzahlen
        seitenzahl += 1
    End Sub
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As _
      System.EventArgs) Handles Button1.Click
        doc.Print()
    End Sub
 
End Class
[/VB]

g.PageUnit = GraphicsUnit.Millimeter

Imports System.Drawing.Printing
 
Public Class frmPrintDemoV2
 
    Dim WithEvents button1 As New Button With {.Parent = Me, .Text = "Drucken"}
 
    Dim zähler As Integer = 0
 
    Dim arr As New List(Of String)
 
    Dim schriftart As New Font("Arial", 12, FontStyle.Regular)
 
    Private WithEvents doc As New PrintDocument()
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles MyBase.Load
 
        For a As Integer = 0 To 300
            arr.Add(CStr(a))
        Next
    End Sub
 
    Private Sub Draw(ByVal g As Graphics, e As PrintPageEventArgs)
 
        Dim c As Color = Color.Black
        Dim f As Font = schriftart
 
        Dim x, y As Double
        x = e.PageSettings.Margins.Left * 25.4 / 100 '1/100 Zoll in Millimeter
        y = e.PageSettings.Margins.Top * 25.4 / 100
 
        For i As Integer = zähler To arr.Count - 1
            If (i + 1) Mod 6 = 0 Then
 
                Dim h As Integer = CInt(Math.Ceiling(g.MeasureString(arr(i), _
                  f).Height))
 
                g.DrawString(arr(i), f, New SolidBrush(c), _
                             New Point(CInt(x), CInt(Math.Ceiling(y))))
 
                x = e.PageSettings.Margins.Left * 25.4 / 100
                y += h
 
            Else
                'Standardbreite der Felder ermitteln, anhand einer Zeichenfolge 
                Dim w As Integer = CInt(Math.Ceiling(g.MeasureString("XXXX", _
                  f).Width))
 
                g.DrawString(arr(i), f, New SolidBrush(c), _
                             New Point(CInt(x), CInt(Math.Ceiling(y))))
                x += w
 
            End If
 
            zähler += 1
 
            If y > e.MarginBounds.Height * 25.4 / 100 Then Exit For
        Next i
    End Sub
 
 
 
    Private Sub Drucker(ByVal sender As Object, ByVal e As PrintPageEventArgs) _
      Handles doc.PrintPage
        Dim g As Graphics = e.Graphics
 
        g.PageUnit = GraphicsUnit.Millimeter
 
        g.TextRenderingHint = _
            Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
 
        Me.Draw(g, e)
 
        e.HasMorePages = zähler < arr.Count - 1
 
    End Sub
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles button1.Click
        zähler = 0
        doc.Print()
    End Sub
 
End Class

Imports System.Drawing.Printing
 
Public Class frmPrintDemoV2
 
    Dim WithEvents button1 As New Button With {.Parent = Me, .Text = "Drucken"}
 
    Dim zähler As Integer = 0
 
    Dim arr As New List(Of String)
 
    Dim schriftart As New Font("Arial", 12, FontStyle.Regular)
 
    Private WithEvents doc As New PrintDocument()
 
    'Angabe zu der Größe und Position des Druckbereichs der Etiketten 
    'in Millimeter
    Dim edb_breite As Single = 50
    Dim edb_höhe As Single = 30
    Dim edb_abstandX As Single = 10
    Dim edb_abstandY As Single = 15
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles MyBase.Load
 
        For a As Integer = 0 To 300
            arr.Add("Nummer " & CStr(a) & vbCrLf & _
                    "Patz für die Kennung" & vbCrLf & Now.ToString)
        Next a
 
    End Sub
 
 
 
    Private Sub Draw(ByVal g As Graphics, e As PrintPageEventArgs)
 
        Dim br As New SolidBrush(Color.Black)
        Dim f As Font = schriftart
 
        Dim x, y As Single
        x = CSng(e.PageSettings.Margins.Left * 25.4 / 100) '1/100 Zoll in 
        ' Millimeter
        y = CSng(e.PageSettings.Margins.Top * 25.4 / 100)
 
        For i As Integer = zähler To arr.Count - 1
            If (i + 1) Mod 6 = 0 Then
 
                Dim h As Integer = CInt(Math.Ceiling(g.MeasureString(arr(i), _
                  f).Height))
 
                g.DrawString(arr(i), f, br, _
                New RectangleF(New PointF(x, y), New SizeF(edb_breite, _
                edb_höhe)), _
                StringFormat.GenericDefault)
 
                x = CSng(e.PageSettings.Margins.Left * 25.4 / 100)
                y += (edb_abstandY + edb_höhe)
            Else
 
                g.DrawString(arr(i), f, br, _
                New RectangleF(New PointF(x, y), New SizeF(edb_breite, _
                edb_höhe)), _
                StringFormat.GenericDefault)
 
                x += (edb_abstandX + edb_breite)
            End If
 
            zähler += 1
            If (y - edb_abstandY) > e.MarginBounds.Height * 25.4 / 100 Then _
              Exit For
        Next i
    End Sub
 
 
 
    Private Sub Drucker(ByVal sender As Object, ByVal e As PrintPageEventArgs) _
      Handles doc.PrintPage
        Dim g As Graphics = e.Graphics
 
        g.PageUnit = GraphicsUnit.Millimeter
 
        g.TextRenderingHint = _
            Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
 
        Me.Draw(g, e)
 
        e.HasMorePages = zähler < arr.Count - 1
 
    End Sub
 
 
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles button1.Click
        zähler = 0
        doc.Print()
    End Sub
 
End Class

Imports System.Drawing.Printing
 
Public Class frmPrintDemoV2
 
    Dim WithEvents button1 As New Button With {.Parent = Me, .Text = "Drucken"}
 
    Dim zähler As Integer = 0
 
    Dim arr As New List(Of String)
 
    Dim schriftart As New Font("Arial", 12, FontStyle.Regular)
 
    Private WithEvents doc As New PrintDocument()
 
    'Angabe zu der Größe und Position des Druckbereichs der Etiketten 
    'in Millimeter
    Dim edb_breite As Single = 30
    Dim edb_höhe As Single = 23
    Dim edb_abstandX As Single = 5
    Dim edb_abstandY As Single = 2.4
 
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles MyBase.Load
 
        For a As Integer = 0 To 73
            arr.Add("Nummer " & CStr(a) & vbCrLf & _
                    "Kennung" & vbCrLf & Now.ToString)
        Next a
 
    End Sub
 
 
 
    Private Sub Draw(ByVal g As Graphics, ByVal e As PrintPageEventArgs)
 
        Dim br As New SolidBrush(Color.Black)
        Dim f As Font = schriftart
 
        Dim x, y As Single
        x = CSng(e.PageSettings.Margins.Left * 25.4 / 100) '1/100 Zoll in 
        ' Millimeter
        y = CSng(e.PageSettings.Margins.Top * 25.4 / 100)
 
        For i As Integer = zähler To arr.Count - 1
            If (i + 1) Mod 6 = 0 Then
 
                Dim h As Integer = CInt(Math.Ceiling(g.MeasureString(arr(i), _
                  f).Height))
 
                g.DrawString(arr(i), f, br, _
                New RectangleF(New PointF(x, y), New SizeF(edb_breite, _
                edb_höhe)), _
                StringFormat.GenericDefault)
 
                x = CSng(e.PageSettings.Margins.Left * 25.4 / 100)
                y += (edb_abstandY + edb_höhe)
            Else
 
                g.DrawString(arr(i), f, br, _
                New RectangleF(New PointF(x, y), New SizeF(edb_breite, _
                edb_höhe)), _
                StringFormat.GenericDefault)
 
                x += (edb_abstandX + edb_breite)
            End If
 
            zähler += 1
            If (y - edb_abstandY) > e.MarginBounds.Height * 25.4 / 100 Then _
              Exit For
        Next i
    End Sub
 
 
 
    Private Sub Drucker(ByVal sender As Object, ByVal e As PrintPageEventArgs) _
      Handles doc.PrintPage
        Dim g As Graphics = e.Graphics
 
        g.PageUnit = GraphicsUnit.Millimeter
 
        g.TextRenderingHint = _
            Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
 
        Me.Draw(g, e)
 
        e.HasMorePages = zähler < arr.Count - 1
 
    End Sub
 
 
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles button1.Click
        zähler = 0
        doc.Print()
    End Sub
 
End Class

Dim ps As New PageSetupDialog
ps.Document = doc
ps.ShowDialog()

zähler += 1
With e.PageSettings
     Dim h As Single = .PrintableArea.Height - .Margins.Top - .Margins.Bottom
     If (y - edb_abstandY) > CSng(h * 25.4 / 100) Then Exit For
End With

Imports System.Drawing.Printing
 
Public Class frmPrintDemoV2
 
    Dim WithEvents button1 As New Button With {.Parent = Me, .Text = "Drucken"}
 
    Dim zähler As Integer = 0
 
    Dim arr As New List(Of String)
 
    Dim schriftart As New Font("Arial", 12, FontStyle.Regular)
 
    Private WithEvents doc As New PrintDocument()
 
    'Angabe zu der Größe und Position des Druckbereichs der Etiketten 
    'in Millimeter
    Dim edb_breite As Single = 30
    Dim edb_höhe As Single = 23
    Dim edb_abstandX As Single = 5
    Dim edb_abstandY As Single = 2.4
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles MyBase.Load
 
        For a As Integer = 0 To 73
            arr.Add("Nummer " & CStr(a) & vbCrLf & _
                    "Kennung" & vbCrLf & Now.ToString)
        Next a
 
    End Sub
 
    Private Sub Draw(ByVal g As Graphics, ByVal e As PrintPageEventArgs)
        Dim br As New SolidBrush(Color.Black)
        Dim f As Font = New Font("Calibri", 9)
        Dim x, y As Single
 
        x = CSng(e.PageSettings.Margins.Left * 25.4 / 100) '1/100 Zoll in 
        ' Millimeter
        y = CSng(e.PageSettings.Margins.Top * 25.4 / 100)
 
        For i As Integer = zähler To arr.Count - 1
            If (i + 1) Mod 6 = 0 Then
 
                Dim h As Integer = CInt(Math.Ceiling(g.MeasureString(arr(i), _
                  f).Height))
 
                g.DrawString(arr(i), f, br, New RectangleF(New PointF(x, y), _
                  New SizeF(edb_breite, edb_höhe)), StringFormat.GenericDefault)
 
                x = CSng(e.PageSettings.Margins.Left * 25.4 / 100)
                y += (edb_abstandY + edb_höhe)
            Else
 
                g.DrawString(arr(i), f, br, New RectangleF(New PointF(x, y), _
                  New SizeF(edb_breite, edb_höhe)), StringFormat.GenericDefault)
 
                x += (edb_abstandX + edb_breite)
            End If
 
            zähler += 1
            With e.PageSettings
                Dim h As Single = .PrintableArea.Height - .Margins.Top - _
                  .Margins.Bottom
                If (y - edb_abstandY) > CSng(h * 25.4 / 100) Then Exit For
            End With
        Next i
    End Sub
 
    Private Sub Drucker(ByVal sender As Object, ByVal e As PrintPageEventArgs) _
      Handles doc.PrintPage
        Dim g As Graphics = e.Graphics
 
        g.PageUnit = GraphicsUnit.Millimeter
        g.TextRenderingHint = _
          Drawing.Text.TextRenderingHint.SingleBitPerPixelGridFit
 
        Me.Draw(g, e)
        e.HasMorePages = zähler < arr.Count - 1
 
    End Sub
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As  _
      System.EventArgs) Handles button1.Click
        Dim ps As New PageSetupDialog
        Dim margins As New Margins(0, 0, 0, 0)
        Dim papersize As New PaperSize("German Std Endlospapier", 850, 1200)
 
        ps.Document = doc
        ps.PageSettings.Margins = margins
        ps.PageSettings.PaperSize = papersize
 
        ps.ShowDialog()
 
        zähler = 0
        doc.Print()
    End Sub
 
End Class

Private Sub out()
        Dim ps As New PageSetupDialog
        Dim margins As New Margins(0, 0, 0, 0)
        Dim papersize As New PaperSize("PaperSize German Std Endlospapier", _
          850, 1200)
 
        ps.Document = doc
        ps.PageSettings.Margins = margins
        ps.PageSettings.PaperSize = papersize
 
        If druck_dialog = True Then
            ps.ShowDialog()
        End If
 
        doc.Print()
    End Sub

Dim papersize As New PaperSize("Custom Paper Size", 302, 277)