mreske
Goto Top

HYPERLINK (Aus Formel in Excel generiert) mit VBA prüfen

Hallo,
ich habe eine Excel Tabelle mit etlichen Hyperlinks:

In Spalte H steht die Rechnungsnummer (z.B. 61789189)
In folgendem Ordner befinden sich die PDF Dateien die per Hyperlin geöffnet werden sollen: W:\Personal\Manuel\FACTURAS_VAUDE
In Spalte L wird der Hyperlink generiert: =Wenn(H10="";"";HIPERLINK("W:\Personal\Manuel\FACTURAS_VAUDE\"&H10&".pdf";"LINK"""))

In Spalte M soll nun per VBA Code ein "x" geschrieben werden, wenn der Hyperlin tot ist (also die entsprechende PDF Datei nicht existiert)

Momentan muss ich das manuell eintragen in dem ich jeden Hyperlin anklicke (entweder öffnet sich dann die PDF Datei oder ich bekomme eine Fehlermeldung)

b728f934f930ee7b246395905943a7d9

Ich freue mich auf Eure Antworten

Viele Grüsse
Manfred

Content-Key: 130892

Url: https://administrator.de/contentid/130892

Ausgedruckt am: 29.03.2024 um 16:03 Uhr

Mitglied: 76109
76109 03.12.2009 um 16:37:22 Uhr
Goto Top
Hallo mreske!

Das folgende Makro überprüft alle Hyperlinks im aktiven Sheet und schreibt in der Folge-Spalte für False = x und für True = Leer.

Jenachdem ob Du Das Makro manuell oder lieber über einen Button starten möchtest, den Code im VB-Editor für manuell in ein Modul oder mit Button in das entsprechende Tabellenblatt kopieren.

Sub TestHyperlinks()
    Dim Fso As Object, Link As Hyperlink
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    For Each Link In ActiveSheet.Hyperlinks
        If Fso.FileExists(Link.Address) = False Then
            Link.Range.Offset(0, 1) = "x"  
        Else
            Link.Range.Offset(0, 1) = ""  
        End If
    Next
End Sub

Gruß Dieter
Mitglied: mreske
mreske 04.12.2009 um 10:28:53 Uhr
Goto Top
Hi Dieter,
vielen Dank für das Script.

Leider funktioniert dieses Script nur bei Hyperlinks, die über "rechte Maustaste -> Hyperlink erstellen -> Ziel aus Explorer auswählen" erstellt wurden.

In meinem Fall wird der Hyperlink aus einer Formel generiert. Das Script erkennt den Hyperlink also als solchen nicht.

Gibt es eine Möglichkeit den VBA Code entsprechend zu ändern?

Viele Grüsse
Mreske
Mitglied: 76109
76109 04.12.2009 um 11:53:11 Uhr
Goto Top
Hallo mreske!

Oha, ich hab's nur mit eingefügten Hyperlinks testen könnenface-sad

Dann sollte das eigentlich funktionieren:
Const Zeile1 = 10   'Hyperlink-Zeilen Begin  
Const Spalte = "L"  'Hyperlink-Spalte  

Private Sub TestHyperlinks()
    Dim Fso As Object, c As Range, EndLine As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HIPERVINCULO*" And c.Text <> "" Then  
            If Fso.FileExists(c) = False Then
                c.Offset(0, 1) = "x"  
            Else
                c.Offset(0, 1) = ""  
            End If
        End If
    Next
End Sub

Gruß Dieter
Mitglied: mreske
mreske 04.12.2009 um 12:45:11 Uhr
Goto Top
Hi Dieter,
vorab erst mal vielen Dank für die Mühe - das hat nicht mal einen halben Tag gedauert und jetzt klappts!

Ich habe das Script etwas abändern müssen:
1. Auch wenn die Excel Formel auf Spanisch ist, muss im VBA SCRIPT wohl *HIPERVINCULO* in *HIPERLINK* geändert werden.
2. In der Excel-Formel hatte ich zu viele Anführungszeichen
3. Anstatt "LINK" muss die Formel in Spalte L jeweils den PFAD angeben.

Die Formel in Excel muss also so lauten:
Auf Spanisch:
=Si(H10="";"";HIPERVINCULO("W:\Personal\Manuel\FACTURAS_VAUDE\"&H10&".pdf";"W:\Personal\Manuel\FACTURAS_VAUDE\"&H10&".pdf"))

Auf Deutsch:
=Wenn(H10="";"";HIPERLINK("W:\Personal\Manuel\FACTURAS_VAUDE\"&H10&".pdf";"W:\Personal\Manuel\FACTURAS_VAUDE\"&H10&".pdf"))

Das Script (funktioniert jetzt perfekt):

Private Sub TestHyperlinks_Click()
Const Zeile1 = 10 'Hyperlink-Zeilen Begin
Const Spalte = "L" 'Hyperlink-Spalte
Dim Fso As Object, c As Range, EndLine As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then
If Fso.FileExists(c) = False Then
c.Offset(0, 1) = "x"
Else
c.Offset(0, 1) = ""
End If
End If
Next
End Sub

Tausend Dank für die Super Hilfe
Mreske
Mitglied: 76109
76109 04.12.2009 um 12:58:52 Uhr
Goto Top
Hallo Mreske!

Yep, gern geschehen. Freut mich, dass es funktioniertface-smile

3. Anstatt "LINK" muss die Formel in Spalte L jeweils den PFAD angeben.
Desdewegen habe ich in weiser Voraussicht nur den Test <And c.Text <> ""> geschrieben, eben weil dieser Wert verändbar istface-wink

Annsonsten, wäre noch sinnvoll den Beitrag als gelöst zu makieren.

Gruß Dieter
Mitglied: mreske
mreske 04.12.2009 um 15:19:15 Uhr
Goto Top
Hallo Dieter,
ich habe jetzt ein paar tausend Links, die ich per VBA-Script getestet habe.

Gibt es eine Möglichkeit, die PDF Dateien, die existieren, per Macro zu öffnen und dann auszudrucken?

Ansonsten müsste ich jede PDF Datei manuell per Hyperlink öffnen und dann ausdrucken.

Viele Grüsse
Mreske
Mitglied: 76109
76109 04.12.2009 um 16:18:16 Uhr
Goto Top
Hallo Mreske!

Zitat von @mreske:
Gibt es eine Möglichkeit, die PDF Dateien, die existieren, per Macro zu öffnen und dann auszudrucken?
Ja das geht, aber das "wie genau" muss ich selber erst mal ausbrobieren und das dauert ein wenigface-wink

Sollen alle/mehrere Pdf's nacheinander gedruckt oder per Selektierung der Zeile und PDF-Druck-Button einzeln gedruckt werden?

Gruß Dieter
Mitglied: mreske
mreske 04.12.2009 um 17:50:07 Uhr
Goto Top
Hallo Dieter,
es reicht, wenn alle PDFs nacheinander gedruckt werden.

Vielen Dank für die Hilfe
Gruss
Mreske
Mitglied: 76109
76109 04.12.2009 um 20:49:06 Uhr
Goto Top
Hallo Mreske!

Hier nochmal komplett Version 1 <TestHyperlink> und <PrintPdf> wobei <Wenn True> der Pfad in Spalte L stehen muss.
Option Explicit

Const Zeile1 = 10   'Hyperlink-Zeilen Begin  
Const Spalte = "L"  'Hyperlink-Spalte  

Const AcrobatReader = """D:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /p /h """  

Private Sub TestHyperlinks_Click()
    Dim Fso As Object, c As Range, EndLine As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            If Fso.FileExists(c) = False Then
                c.Offset(0, 1) = "x"  
            Else
                c.Offset(0, 1) = ""  
            End If
        End If
    Next
End Sub


Private Sub PrintPdf_Click()
    Dim Fso As Object, c As Range, EndLine As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            If Fso.FileExists(c) = True Then
                Shell AcrobatReader & c & """", vbMinimizedNoFocus  
            End If
        End If
    Next
End Sub
Hier Version 2 <TestHyperlink> und <PrintPdf> wobei Du wieder die ursprüngliche Formel verwenden kannst (Zellinhalt = "Link"):
Option Explicit

Const Zeile1 = 10           'Hyperlink-Zeilen Begin  
Const Spalte = "L"          'Hyperlink-Spalte  

Const PdfName = "H"         'Spalte Pdf-Name  

'Pfad der Pdf-Dateien mit Variable (?) für Dateiname  
Const PdfPfad = "W:\Personal\Manuel\Facturas_Vaude\?.pdf"   

Const AcrobatReader = """D:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /p /h """  

Private Sub TestHyperlinks_Click()
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName))  
            If Fso.FileExists(Pdf) = False Then
                c.Offset(0, 1) = "x"  
            Else
                c.Offset(0, 1) = ""  
            End If
        End If
    Next
End Sub


Private Sub PrintPdf_Click()
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName))  
            If Fso.FileExists(Pdf) = True Then
                Shell AcrobatReader & Pdf & """", vbMinimizedNoFocus  
            End If
        End If
    Next
End Sub
Die Konstante <PdfPfad> sollte stimmen. Die Konstante <AcrobatReader> muss angepasst werden, aber darauf achten, dass die Hochkommas so bleiben, wie sie sind. Das ist insofern wichtig, damit Programm- und Dateinamen Leerzeichen enthalten dürfen.

Bei Version 1 habe ich wohl etwas geschlafen und nicht bedacht, dass der Dateipfad unglücklicherweise in der Zelle stehen mussface-sad

In Version 2 wird der Dateipfad durch auslesen der Spalte H automatisch generiert, sodass in Spalte L ein belieber Text stehen kannface-smile

Der Druckvorgang für die PDF-Dateien klappt soweit, allerdings kann ich nicht vorhersagen, ob es auch in großem Umfang funktioniert. Getestet habe ich es mit 26 1-Seitigen Pdf-Dateien. Wieviel Druckaufträge letztendlich gesendet werden können, hängt davon ab, wieviel Druckaufträge die Druckerwarteschlange aufnehmen kann. Der AcrobatReader muss am Ende manuell geschlossen werden (Minimize Taskleiste).

Gruß Dieter
Mitglied: mreske
mreske 09.12.2009 um 11:19:03 Uhr
Goto Top
Hallo Dieter,
erstmal vielen Dank für das Script. Leider bin ich noch nicht dazu gekommen, es zu testen (wir hatten hier einen Feiertag und einen Brückentag und fangen erst heute wieder an zu arbeiten).

Ich melde mich sobald ich das Script getestet habe

Viele grüsse
MReske
Mitglied: 76109
76109 09.12.2009 um 11:30:20 Uhr
Goto Top
Hallo MReske!

Yepp, gern geschehenface-smile

Wie das mit dem Drucken so ausgeht, würde mich schon interessieren und fände es daher toll, wenn Du bei Gelegenheit ein Feedback dazu abgibst.

Gruß Dieter
Mitglied: mreske
mreske 10.12.2009 um 10:12:30 Uhr
Goto Top
Hi Dieter,
jetzt habe ich das Makro getestet und es funktioniert perfekt (habe nur den Pfad vom Acrobat geändert). Wie das Script bei grossen Druckaufträgen reagiert habe ich noch nicht getestet, lediglich mit ca.100 Druckaufträgen. Das probiere ich aber noch aus und gebe hier dann die entsprechende Info.

Hier noch einmal das Script:

Private Sub PrintPdf_Click()
Const Zeile1 = 10 'Hyperlink-Zeilen Begin
Const Spalte = "L" 'Hyperlink-Spalte
Const AcrobatReader = """C:\Archivos de programa\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe"" /p /h """
Dim Fso As Object, c As Range, EndLine As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then
If Fso.FileExists(c) = True Then
Shell AcrobatReader & c & """", vbMinimizedNoFocus
End If
End If
Next
End Sub

Nochmals tausend dank für die Mühe

Gruss
Mreske
Mitglied: 76109
76109 10.12.2009 um 13:57:51 Uhr
Goto Top
Hallo Mreske!

Zitat von @mreske:
Hi Dieter,
jetzt habe ich das Makro getestet und es funktioniert perfekt (habe nur den Pfad vom Acrobat geändert). Wie das Script bei
grossen Druckaufträgen reagiert habe ich noch nicht getestet, lediglich mit ca.100 Druckaufträgen. Das probiere ich aber
noch aus und gebe hier dann die entsprechende Info.
Danke. 100 ist doch schon mal was und lass Dir ruhig Zeit mit dem Ganzen. Es hat überhaupt keine Eileface-smile

Gruß Dieter
Mitglied: mreske
mreske 11.12.2009 um 15:34:07 Uhr
Goto Top
Hi Dieter,
das Makro läuft seit gut einer Stunde und hat bisher ca.1500 Seiten gedruckt - alles läuft bestens ohne Probleme. Es scheint also, als würde der Druckauftrag bei grosser Datenmenge nicht abbrechen.

Jetzt habe ich schon ein schlechtes Gewissen, dich um eine Erweiterung zu fragen (im Internet finde ich aber nichts dazu).

Ich möchte jetzt eine CD anlegen, in der alle PDF Dateien, die in der Excel Tabelle mit einem "x" als existent markiert sin, per Makro kopieren und in einen neuen Ordner (z.B.: W:\Personal\Manuel\FACTURAS_VAUDE_COPY) eingefügt werden (also im Prinzip den "DRUCKEN"Befehl in ein COPY + PASTE Befehl umwandeln .

Damit will ich dann zusätzlich eine CD erstellen, in der alle PDF Dateien zu finden sind.

Könntest Du mir mit diesem Befehl bitte noch einmal behilflich sein?

Viele Grüsse
Manfred
Mitglied: 76109
76109 11.12.2009 um 18:59:01 Uhr
Goto Top
Hallo Manfred!

Zitat von @mreske:
das Makro läuft seit gut einer Stunde und hat bisher ca.1500 Seiten gedruckt - alles läuft bestens ohne Probleme. Es
scheint also, als würde der Druckauftrag bei grosser Datenmenge nicht abbrechen.
Tollface-smile
Jetzt habe ich schon ein schlechtes Gewissen, dich um eine Erweiterung zu fragen (im Internet finde ich aber nichts dazu).
Ein schlechtes Gewissen musst Du deswegen nicht haben. Ich kann ja erstens Nein sagen und zweitens ist es keine große Sacheface-wink
Ich möchte jetzt eine CD anlegen, in der alle PDF Dateien, die in der Excel Tabelle mit einem "x" als existent
markiert sin, per Makro kopieren und in einen neuen Ordner (z.B.: W:\Personal\Manuel\FACTURAS_VAUDE_COPY) eingefügt werden
(also im Prinzip den "DRUCKEN"Befehl in ein COPY + PASTE Befehl umwandeln
Da haben wir jetzt schon ein kleines Missverständnis, weil es im Erstbeitrag hieß, dass die PDF's - die tot sind - ein "x" haben sollen und im meinen Codes auch so gehandhabt wurde?
Könntest Du mir mit diesem Befehl bitte noch einmal behilflich sein?
Ich werd's versuchenface-smile

Und welche der beiden Versionen verwendest Du jetzt? Version 1 oder Version 2

Gruß Dieter
Mitglied: 76109
76109 12.12.2009 um 10:52:03 Uhr
Goto Top
Hallo Manfred!

Passend zum letzten Code weiter oben, CopyPdf Version 1 und 2.

Version 1:
Const PdfCopyPfad = "W:\Personal\Manuel\Facturas_Vaude_Copy"  

Private Sub CopyPdf_Click()
    Dim Fso As Object, c As Range, EndLine As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
   'On Error Resume Next:  Fso.DeleteFolder PdfCopyPfad, True:  On Error GoTo 0  
    
   'Fso.CreateFolder PdfCopyPfad  

    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            If Fso.FileExists(c) = True Then Fso.CopyFile c, PdfCopyPfad & "\"  
        End If
    Next
End Sub
Wobei die Const-Zeile 1 zu den anderen Konstanten am Anfang des Codes hinzuzufügen ist. Wenn vor dem kopieren der Kopie-Ordner geleert werden soll, dann in den Zeilen 8 und 10 die Kommentarzeichen entfernen. Funktion Zeile 8 ist [Kopie-Ordner löschen wenn er existiert] und Zeile 10 ist [Kopie-Ordner neu erstellen].

Version 2:
Const PdfCopyPfad = "W:\Personal\Manuel\Facturas_Vaude_Copy"  

Private Sub CopyPdf_Click()
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String
    
    Set Fso = CreateObject("Scripting.FileSystemObject")  
    
   'On Error Resume Next:  Fso.DeleteFolder PdfCopyPfad, True:  On Error GoTo 0  
    
   'Fso.CreateFolder PdfCopyPfad  

    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row
    
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte))
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then  
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName))  
            If Fso.FileExists(Pdf) = True Then Fso.CopyFile Pdf, PdfCopyPfad & "\"  
        End If
    Next
End Sub
Die Zeile 1, 8 und 10, wie bei Version 1

Wenn das "x" die existierenden Pdf's repräsentieren soll, dann musst Du ja nur in True/False das "" und "x" vertauschen. In dem Fall könntest Du aber auch für False "" und für True ein kleines "ü" nehmen und in der Spalte das Schrift-Format "Windings 11 fett Schriftfarbe Grün" für ein Häkchen verwendenface-smile

Gruß Dieter
Mitglied: mreske
mreske 14.12.2009 um 13:21:43 Uhr
Goto Top
Hi Dieter,
was soll ich sagen....?!.....die Version 1 hat auf Anhieb funktioniert ohne was am Code ändern zu müssen.

Vielen vielen Dank für die Super Hilfe Dieter, so was nenne ich mal professionell und unkompliziert!!!!

SUPER FORUM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Viele Grüsse
MRESKE
Mitglied: 76109
76109 14.12.2009 um 16:33:01 Uhr
Goto Top
Hallo Manfred!

Zitat von @mreske:
was soll ich sagen....?!.....die Version 1 hat auf Anhieb funktioniert ohne was am Code ändern zu müssen.
Freut mich, dass es auf Anhieb funktioniert hatface-smile
Vielen vielen Dank für die Super Hilfe Dieter, so was nenne ich mal professionell und unkompliziert!!!!
Gern geschehen. Man tut was man kann, um anderen die Arbeit etwas leichter zu machen face-smile

Gruß Dieter
Mitglied: Zwinckerchen
Zwinckerchen 27.01.2010 um 13:16:55 Uhr
Goto Top
Hallo Dieter,
vielen, vielen Dank für den tollen Thread - ich habe auch seeeehr davon profitiert.
Allerdings stehe ich jetzt vor einem weiteren Problem: Kann ich bei dem Druckbefehl auch noch irgendwo einen Drucker angeben? Denn ich möchte meine PDFs nicht auf den Standarddrucker schicken. Also etwas wie

Shell AcrobatReader & LinkAdresse & """Druckername auf Ne00:", vbMinimizedNoFocus

(Ansonsten Konstanten und Variablen aus dem obigen Code).
Danke für jeden Hinweis!!!
Grüße
Tine
Mitglied: 76109
76109 27.01.2010 um 15:52:42 Uhr
Goto Top
Hallo Tine!

Du kannst vor dem Druckauftrag den aktiven Standard-Druckernamen in eine Variable sichern und Deinen Wunsch-Drucker als Standard-Drucker festlegen. Nach dem Druckauftrag dann einfach den gesicherten Druckernamen wieder als Standard-Drucker festlegen.
    Dim StdDrucker As String

    StdDrucker = Application.ActivePrinter
    
    Application.ActivePrinter = "Druckername auf Ne00:"  
    
    Shell AcrobatReader.....
    
    Application.ActivePrinter = StdDrucker

Den Namen des Standard-Druckers kannst Du mit dieser Routine auslesen:
Sub GetStdPrinterName()
    MsgBox "Die Druckerbezeichnung: " & Application.ActivePrinter  
End Sub
Drucker zum auslesen vorher als Standard-Drucker festlegen.

Gruß Dieter
Mitglied: Zwinckerchen
Zwinckerchen 28.01.2010 um 10:30:29 Uhr
Goto Top
Hallo Dieter,
danke für die Antwort - klappt leider nicht. Der Druckauftrag geht auf den Standarddrucker.
Ich nutze Office XP, und da scheint die von Dir vorgeschlagene Routine nur den Excel-Standarddrucker zu beeinflussen und nicht den Windows-Standarddrucker, auf den ja dann offenbar Acrobat zugreift.....
Fällt Dir dazu noch was ein?
Danke!!!!
Grüße
Tine
Mitglied: 76109
76109 28.01.2010 um 15:14:49 Uhr
Goto Top
Hallo Tine!

Sorry, der Wechsel des Standard-Druckers hat natürlich nur Auswirkungen beim Drucken von Excel-Dateien.

U.a. habe ich folgendes gegoogelt und könnte Dir weiterhelfen:
The DDE command line parameters for Acrobat and Reader are as follows. These are unsupported but have worked for some developers.

AcroRd32.exe /p filename - executes the Reader and prints a file
AcroRd32.exe /t path printername drivername portname - Initiates

Acrobat Reader, prints a file while suppressing the Acrobat print dialog box, then terminates Reader.

The four parameters of the /t option evaluate to path,printername, drivername, and portname (all strings).
printername - The name of your printer.
drivername - Your printer driver’s name. Whatever appears in the Driver Used box when you view your printer’s properties.
portname - The printer's port. portname cannot contain any "/" characters; if it does, output is routed to the default port for that printer.

Gruß Dieter
Mitglied: 76109
76109 28.01.2010 um 20:31:47 Uhr
Goto Top
Hallo Tine!

Falls der Versuch mit der Akrobat-Kommandozeile (/t) nicht klappt, könntest Du diesen Code mal testen. Bei mir funktionierts bestensface-wink

Option Explicit
Option Compare Text

Const strComputer = "."  

Const PdfPrinter = "Canon MX850 series Printer"  

Const ErrMsg = "Setzen des Standard-Druckers fehlgeschlagen"  

Private Sub PrintPdf()
    Dim StdPrinter As String
    
    StdPrinter = GetStdPrinter
    
    If SetStdPrinter(PdfPrinter) = False Then MsgBox ErrMsg, vbExclamation, "Fehler":  Exit Sub  
    
   'Pdf's drucken...  
    
    If SetStdPrinter(StdPrinter) = False Then MsgBox ErrMsg, vbExclamation, "Fehler"  
End Sub

Private Function GetStdPrinter() As String
    Dim objWMIService As Object, colItems As Object, objItem As Object
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")  
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", , 48)  
    
    For Each objItem In colItems
        If objItem.Default = True Then GetStdPrinter = objItem.Name:  Exit For
    Next
End Function

Private Function SetStdPrinter(ByRef Printer) As Boolean
    Dim objWMIService As Object, colItems As Object, objItem As Object
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")  
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", , 48)  
    
    For Each objItem In colItems
        If objItem.Name Like Printer Then objItem.SetDefaultPrinter:  SetStdPrinter = True:  Exit For
    Next
End Function

Falls beides USB-Drucker sind, kannst Du Sql-Anweisung auch ändern in:
("SELECT * FROM Win32_Printer WHERE PortName LIKE 'USB%'", , 48)  

Gruß Dieter
Mitglied: Zwinckerchen
Zwinckerchen 29.01.2010 um 12:32:49 Uhr
Goto Top
Hallo Dieter,
vielen, vielen Dank für die geduldige und ausführliche Hilfe: Ich habe es mit der Kommandozeilenvariante hinbekommen:

                    
Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " _  
                                & LinkAdresse & " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus  

Ich musste ein paar Mal probieren, bis ich die Anführungszeichen richtig verteilt hatte, aber jetzt geht's - 1000 Dank!

Grüße
Tine
Mitglied: Zwinckerchen
Zwinckerchen 29.01.2010 um 12:48:52 Uhr
Goto Top
PS: Hallo Dieter,
einen habe ich noch, vielleicht kannst Du mir da auch weiterhelfen......

Die Links der zu druckenden PDF-Dokumente holt sich VBA aus meiner Exceltabelle, Links können in den Spalten 15 bis 28 der jeweiligen Zeile stehen.
Die zugehörige Schleife habe ich mittels "Range" realisiert:

  For Each c In Range(Cells(ZeilenNr, 15), Cells(ZeilenNr, 28))
            If c.Hyperlinks.Count And c.Text <> "" Then  
            For Each Link In c.Hyperlinks
                LinkAdresse = "K:\testordner\" + Link.Address  
                If Fso.FileExists(LinkAdresse) = True Then
                    Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " _   
                               & LinkAdresse & " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus  
                End If
            Next
            End If

Leider arbeitet er die Zellen nicht von links nach rechts ab, sondern nimmt meistens erst das erste Dokument und dann von rechts nach links, unabhängig davon, wie in der Zeile "For Each c in Range" die Grenzen gesetzt sind (jeweils 2. Koordinate vertauscht). Ist das bei Range so? Muss ich dann doch eine For-Schleife machen, die die Zellen in der richtigen Reihenfolge abarbeitet?
Danke!!!!
Grüße
Tine
Mitglied: 76109
76109 29.01.2010 um 14:33:51 Uhr
Goto Top
Hallo Tine!

Find ich Toll, dass Du es doch mit der Akrobat-Kommandozeile hinbekommen hastface-smile

Die Schleifen würde ich in dem Fall so machen:
For r = BegLine To EndLine
    For c = 15 To 28
        If Cells(r, c).Hyperlinks.Count Then
            LinkAdresse = "K:\testordner\" + Cells(r, c).Hyperlinks(1).Address  
            If Fso.FileExists(LinkAdresse) = True Then
                Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " & LinkAdresse & _  
                      " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus  
            End If
        End If
    Next
Next

Dann wünsche ich Dir ein schönes WE


Gruß Dieter
Mitglied: Zwinckerchen
Zwinckerchen 29.01.2010 um 15:18:46 Uhr
Goto Top
Hallo Dieter,
danke für den Hinweis. Ich habe festgestellt, dass das Problem nicht von Excel verursacht wird, sondern im weiteren Ablauf in der Kommunikation mit dem Drucker.
Auch mit der "For"-Schleife stimmt die Reihenfolge manchmal nicht, aber wenn ich in meinem Makro eine Verzögerung von 2s via application.wait einfüge, ist alles richtig. Die Range-Schleife funktioniert mit einer Verzögerung von 3s.
Dir auch ein schönes Wochenende,
Grüße
Tine
Mitglied: 76109
76109 29.01.2010 um 15:48:05 Uhr
Goto Top
Hallo Tine!

Dann wäre eventuell die Methode mit setzen des Standard-Druckers doch sinnvoller. Da werden die Druckaufträge der Reihe nach in der Druckerwarteschlange gespoolt und der Reihe nach an den Drucker weitergegeben?

Gruß Dieter
Mitglied: Zwinckerchen
Zwinckerchen 01.02.2010 um 09:59:26 Uhr
Goto Top
Hallo Dieter,
die Routine mit dem Standarddrucker-Umsetzen funktioniert prinzipiell prima, allerdings ist folgendes zu beachten: Man muss aufpassen, dass vor dem Start der Druckroutine Acrobat noch nicht geöffnet ist, sonst bekommt Acrobat das Ändern des Standarddruckers nicht mit - ich schließe am Ende der Routine mittels:

Private Sub AcroReaderBeenden()
 
Dim objWMI As Object
Dim objProcess As Object
Dim colSystem As Object
 
 
Set objWMI = GetObject("winmgmts:")  
Set colSystem = objWMI.InstancesOf("win32_process")  
 
For Each objProcess In colSystem
  If objProcess.Name = "AcroRd32.exe" Then  
    objProcess.Terminate
  End If
Next
 
Set colSystem = Nothing
Set objProcess = Nothing
Set objWMI = Nothing
 
End Sub

Allerdings ist Excel schneller als Acrobat, wenn man den Schließbefehl normal am Ende der Druck-Sub aufruft, werden möglicherweise nicht alle Dokumente gedruckt, weil Acrobat schon geschlossen ist, bevor alle Dokumente gedruckt sind. D.h. ich füge hier auch wieder eine Verzögerung ein.
Und die Reihenfolge mit dem Drucken scheint wirklich an Acrobat zu hängen, denn auch bei der Standarddruckervariante stimmt die Reihenfolge manchmal nicht. Offenbar öffnet Acrobat ein File nach dem anderen, gibt aber kleine Dokumente schneller an den Drucker weiter als große.
Also bleibe ich wohl bei meiner Kommandozeilenvariante mit Wartezeit.....

Grüße
Tine
Mitglied: 76109
76109 01.02.2010 um 19:24:17 Uhr
Goto Top
Hallo Tine!

Naja, wenigstens funktioniert das Ganzeface-smile Wenn auch nicht so, wie ich mir das vorgestellt hatte.

Danke für die Hinweiseface-smile

Gruß Dieter