Public MyPrinter As VBAPrinter.AcadVBAPrinter
 
 
Dim Dateiname As String
Dim ImportPfad As String
Dim Bild(2) As IPictureDisp
Dim DateiZahl As String, i As Integer, c As Integer
Dim acYPos As String
Dim MatNr As String
 
Private Sub cmdDruck_Click()
 
On Error Resume Next
Set MyPrinter = New VBAPrinter.AcadVBAPrinter
 
MyPrinter.VBAPrinter.Scalemode = vbMillimeters
 
ImportPfad = TextBox1.Value & "\"               'Verzeichnispfad
Dateiname = Dir(ImportPfad & "*.dwg")           'Dateiname mitVerzechnispfad 
' als String
acYPos = 10                                     'Basisposition für CurrentY
 
 
'--Anzahl der Datenzätze ermitteln--!
i = 0
DateiZahl = Dir$(ImportPfad & "*.dwg")
Do While DateiZahl <> ""
    i = i + 1
    DateiZahl = Dir$()
Loop
 
'--Kopfzeile drucken--!
PrintHead
 
'--Materialgruppe drucken--!
PrintMaterialgruppe
 
'--Icon - Zuweisung für ok und nicht ok--!
Set Bild(0) = FolderDruck.ImageList1.ListImages(1).Picture
Set Bild(1) = FolderDruck.ImageList1.ListImages(2).Picture
 
'--Bild - Zuweisung für ok und nicht ok--!
Set Bild(2) = LoadPicture( _
  "N:\Konstruktion\AutoCAD\Bloecke_Artikel\108\APV-150-STBL 65 mm_D.wmf")
'(für "APV-150-STBL 65 mm_D.dwg" müßte ein Schleifendurchlauf eingebaut werden)
 
 
'Do While Dateiname <> ""   '??????????
'--Picture Box drucken--!
For c = 0 To i
    PrintPicture01
    acYPos = acYPos + 35
Next
'------------------------
'Loop                       '??????????
 
MyPrinter.VBAPrinter.EndDoc
 
End Sub
 
'--Kopfzeile drucken--!
Function PrintHead()
With MyPrinter
    .VBAPrinter.currentx = 10
    .VBAPrinter.currenty = acYPos
    .VBAPrinter.Print Left(ImportPfad, Len(ImportPfad) - 1)
    .VBAPrinter.Line (10, acYPos + 5)-Step(180, 0)
End With
End Function
 
'--Materialgruppe drucken--!
Function PrintMaterialgruppe()
MatNr = Left(ImportPfad, Len(ImportPfad) - 1)
MatNr = Right(MatNr, Len(MatNr) - (Len(MatNr) - 3))
With MyPrinter
    .VBAPrinter.currentx = 10
    .VBAPrinter.currenty = acYPos + 15
    .VBAPrinter.Print "Für die Materialgruppe - " & MatNr & " - gibt es" & _
      "folgende Blöcke: "
End With
End Function
 
'--Bild drucken--!
Function PrintPicture01()
With MyPrinter
    .VBAPrinter.PaintPicture Bild(2), 10, acYPos + 35
    .VBAPrinter.currentx = 100
    .VBAPrinter.currenty = acYPos + 40
    .VBAPrinter.Print "APV-150-STBL 65 mm_D.dwg"
    '(für "APV-150-STBL 65 mm_D.dwg" müßte ein Schleifendurchlauf eingebaut 
    ' werden)
    .VBAPrinter.PaintPicture Bild(0), 155, acYPos + 40
    .VBAPrinter.currentx = 100
    .VBAPrinter.currenty = acYPos + 45
    .VBAPrinter.Print "APV-150-STBL 65 mm_S.dwg"
    .VBAPrinter.PaintPicture Bild(0), 155, acYPos + 45
    .VBAPrinter.currentx = 100
    .VBAPrinter.currenty = acYPos + 50
    .VBAPrinter.Print "APV-150-STBL 65 mm_F.dwg"
    .VBAPrinter.PaintPicture Bild(0), 155, acYPos + 50
    .VBAPrinter.currentx = 100
    .VBAPrinter.currenty = acYPos + 55
    .VBAPrinter.Print "APV-150-STBL 65 mm_P.dwg"
    .VBAPrinter.PaintPicture Bild(1), 155, acYPos + 55
End With
End Function

VG

Dirk