---

Drucken_VBAPrinter_01.jpg Drucken_VBAPrinter_02.jpg

Guten Morgen zusammen!

Ich möchte aus einem meiner VBA - Tools heraus drucken.
(Standarddrucker)
Da CommonDialog (Printer) nicht von VBA unterstützt wird, ist das nicht ganz so einfach.
Mit dem VBA Printer Setup von der Tool CD "AutoCAD programmieren mit VBA" sollte es aber ja eigentlich funktionieren.
Leider scheint es da bei der Installation der *.dll ein Problem zu geben, denn auch hierbei wird das Printer - Objekt nicht unterstützt.

Code:

---

Dim MyPrinter As VBAPrinter.AcadVBAPrinter
Set MyPrinter = New VBAPrinter.AcadVBAPrinter

MyPrinter.Printer "Dieses ist ein Testdruck"

MyPrinter.EndDoc

---

Den Verweis gibt es aber, merkwürdig 

Es wäre super, wenn mir da jemand bei weiterhelfen könnte.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

ich kenne das Tool von dir nicht.
Ich könnte mir nur vorstellen, das "MyPrinter.Printer" eher eine Eigenschaft zum zuweisen des Druckers ist.

Hab nur [URL=http://books.google.de/books?id=HXG2N2Wy6iMC&pg=PA886&lpg=PA886&dq=VBAPrinter.AcadVBAPrinter&source=bl&ots=air9fxjhE6&sig=HKALuMZAb9pe9RCH2CzfiJx8_Ec&hl=de&sa=X&ei=BHOiT8_JH8X k4QTg4tHOCA&ved=0CDAQ6AEwAQ#v=onepage&q=VBAPrinter.AcadVBAPrinter&f=false]das[/URL] gefunden.
Demnach würde es mit MyPrinter.VbaPrinter.print "TEXT" gehen.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht. 
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Drucken_VBAPrinter_03.jpg

Hallo Wilfried!

Danke für die Info.
Soweit läuft es nun auch schon.

Problem habe ich jetzt noch mit dem Durchlauf des Verzeichnis
und dem drucken der MyPrinter.VBAPrinter.Print - Anweisung, so dass
die Bilder und Infos untereinander weggedruckt werden und auf der nächsten Seite fortgesetzt werden.

Hier mal der Auszug aus meinem Tool:

Code:

---

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

---

Hättest Du oder jemand aus dem Forum eine Idee wie ich das richtig schreiben bzw. das Problem lösen könnte.

Vielen Dank im Voraus.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

ich nehme an hier ist das Problem

Code:

---

'Do While Dateiname <> ""  '??????????
'--Picture Box drucken--!
For c = 0 To i
    PrintPicture01
    acYPos = acYPos + 35
Next
'------------------------
'Loop                      '??????????

---

Weiter oben hast du die Lösung

Code:

---

DateiZahl = Dir$(ImportPfad & "*.dwg")
Do While DateiZahl <> ""
    PrintPicture01
    acYPos = acYPos + 35
    DateiZahl = Dir$()
Loop

---

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Drucken_VBAPrinter_04.jpg Drucken_VBAPrinter_05.jpg

Hallo Wilfried!

Danke, soweit läuft es nun.

Wo ich noch Probleme mit habe, ist eine Abfrage bezogen auf den DateiPfad.
Zu der Datei z.B. APV-150-STBL 65 mm_D.dwg gehören auch immer folgende:
APV-150-STBL 65 mm_S.dwg
APV-150-STBL 65 mm_F.dwg
APV-150-STBL 65 mm_P.dwg
APV-150-STBL 65 mm.pdf

Wie baue ich diese Abfrage noch mit ein, so dass man an Hand der Icons, siehe Anlage,
sehen kann ob ja oder nein.

In einigen Verzeichnissen kann es schon mal sein, das es die Datei *_P.dwg nicht gibt.

Code:

---

'--Icon - Zuweisung für ok und nicht ok-----------------------------------------------------------
Set Bild(0) = FolderDruck.ImageList1.ListImages(1).Picture
Set Bild(1) = FolderDruck.ImageList1.ListImages(2).Picture
'-------------------------------------------------------------------------------------------------

'--Dim DateiZahl As String, i As Integer----------------------------------------------------------
DateiPfad = Dir$(ImportPfad & "*_D.dwg")
'-------------------------------------------------------------------------------------------------

'--Picture Box + Blocknamen drucken---------------------------------------------------------------
Do While DateiPfad <> ""
    BildPfad = ImportPfad & "\" & Left(DateiPfad, Len(DateiPfad) - 6) & "_D.wmf"
    Set Bild(2) = LoadPicture(BildPfad)
    If MyPrinter.VBAPrinter.CurrentY >= (MyPrinter.VBAPrinter.ScaleHeight * 1.5) - acYPos Then
        MyPrinter.VBAPrinter.NewPAge
        acYPos = 10
        PrintHead
        PrintMaterialgruppe
    End If
   
    PrintPicture01
    acYPos = acYPos + 35

    Debug.Print DateiPfad
    DateiPfad = Dir$()
Loop
'-------------------------------------------------------------------------------------------------
MyPrinter.VBAPrinter.EndDoc
'-------------------------------------------------------------------------------------------------

---

Hiermit war ich mal angefangen zu experimentieren, aber bislang ohne Erfolg:

Code:

---

Function PrintPicture01()
With MyPrinter
    .VBAPrinter.PaintPicture Bild(2), 15, acYPos + 35

    '--- Position für *_D.dwg / wenn _D.dwg vorhanden---------------------------------------------
    .VBAPrinter.currentx = 100
    .VBAPrinter.CurrentY = acYPos + 40
    If Len(DateiPfad) > 0 Then
        .VBAPrinter.Print DateiPfad
        .VBAPrinter.PaintPicture Bild(0), 165, acYPos + 40
    Else
        .VBAPrinter.Print DateiPfad
        .VBAPrinter.PaintPicture Bild(1), 165, acYPos + 40
    End If

    '--- Position für *_S.dwg / wenn _S.dwg vorhanden---------------------------------------------
    .VBAPrinter.currentx = 100
    .VBAPrinter.CurrentY = acYPos + 45
    If DateiPfad = Left(DateiPfad, Len(DateiPfad) - 6) & "_S.dwg" Then
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_S.dwg"
        .VBAPrinter.PaintPicture Bild(0), 165, acYPos + 45
    Else
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_S.dwg"
        .VBAPrinter.PaintPicture Bild(1), 165, acYPos + 45
    End If

    '--- Position für *_F.dwg / wenn _F.dwg vorhanden---------------------------------------------
    .VBAPrinter.currentx = 100
    .VBAPrinter.CurrentY = acYPos + 50
    '.VBAPrinter.Print DWG_F
    If DateiPfad = Left(DateiPfad, Len(DateiPfad) - 6) & "_F.dwg" Then
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_F.dwg"
        .VBAPrinter.PaintPicture Bild(0), 165, acYPos + 50
    Else
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_F.dwg"
        .VBAPrinter.PaintPicture Bild(1), 165, acYPos + 50
    End If

    '--- Position für *_P.dwg / wenn _P.dwg vorhanden---------------------------------------------
    .VBAPrinter.currentx = 100
    .VBAPrinter.CurrentY = acYPos + 55
    '.VBAPrinter.Print DWG_P
    If DateiPfad = Left(DateiPfad, Len(DateiPfad) - 6) & "_P.dwg" Then
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_P.dwg"
        .VBAPrinter.PaintPicture Bild(0), 165, acYPos + 55
    Else
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & "_P.dwg"
        .VBAPrinter.PaintPicture Bild(1), 165, acYPos + 55
    End If

    '--- Position für *.pdf Datei / wenn .pdf vorhanden-------------------------------------------
    .VBAPrinter.currentx = 100
    .VBAPrinter.CurrentY = acYPos + 60
    '.VBAPrinter.Print DWG_P
    If DateiPfad = Left(DateiPfad, Len(DateiPfad) - 6) & ".pdf" Then
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & ".pdf"
        .VBAPrinter.PaintPicture Bild(0), 165, acYPos + 60
    Else
        .VBAPrinter.Print Left(DateiPfad, Len(DateiPfad) - 6) & ".pdf"
        .VBAPrinter.PaintPicture Bild(1), 165, acYPos + 60
    End If

End With
End Function

---

Könntest Du mir dabei weiterhelfen?

Vielen Dank im Voraus.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

meinst du so was?

Code:

---

Sub test()
    Dim fso As New FileSystemObject
    Dim Path As String
    Dim Folder As Scripting.Dictionary
    Dim Pattern As String
    Dim ParentFilename As String
    Dim BasicFilename As String
    Dim Filename As String
   
    Path = "C:\temp\test\"
    Pattern = "*_D.txt"
   
    If Not fso.FolderExists(Path) Then
        MsgBox "Pfad existiert nicht"
    End If
   
    ParentFilename = Dir(Path & Pattern)
    While ParentFilename <> ""
        BasicFilename = Left(ParentFilename, Len(ParentFilename) - 6)
       
        Filename = BasicFilename & "_S.txt"
        If fso.FileExists(Path & Filename) Then
            Debug.Print "Datei " & Filename & " vorhanden"
        Else
            Debug.Print "Datei " & Filename & " NICHT vorhanden"
        End If
   
        Filename = BasicFilename & "_F.txt"
        If fso.FileExists(Path & Filename) Then
            Debug.Print "Datei " & Filename & " vorhanden"
        Else
            Debug.Print "Datei " & Filename & " NICHT vorhanden"
        End If
   
        Filename = BasicFilename & ".pdf"
        If fso.FileExists(Path & Filename) Then
            Debug.Print "Datei " & Filename & " vorhanden"
        Else
            Debug.Print "Datei " & Filename & " NICHT vorhanden"
        End If
   
        ParentFilename = Dir
    Wend
   
End Sub

---

Du musst als Verweis "Microsoft Scripting Runtime" aktiviert haben.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Wilfried!

Vielen Dank, genau das wars

Es funktioniert nun prima.

Einen schönen Tag wünsch ich Dir noch.

------------------
Gruß

Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP