Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

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

Frage Entwicklung VB for Applications

Mitglied: mreske

mreske (Level 1) - Jetzt verbinden

03.12.2009 um 15:08 Uhr, 17251 Aufrufe, 30 Kommentare

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 - Klicke auf das Bild, um es zu vergrößern

Ich freue mich auf Eure Antworten

Viele Grüsse
Manfred
30 Antworten
Mitglied: 76109
03.12.2009 um 16:37 Uhr
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.

01.
Sub TestHyperlinks() 
02.
    Dim Fso As Object, Link As Hyperlink 
03.
     
04.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
05.
     
06.
    For Each Link In ActiveSheet.Hyperlinks 
07.
        If Fso.FileExists(Link.Address) = False Then 
08.
            Link.Range.Offset(0, 1) = "x" 
09.
        Else 
10.
            Link.Range.Offset(0, 1) = "" 
11.
        End If 
12.
    Next 
13.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: mreske
04.12.2009 um 10:28 Uhr
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
Bitte warten ..
Mitglied: 76109
04.12.2009 um 11:53 Uhr
Hallo mreske!

Oha, ich hab's nur mit eingefügten Hyperlinks testen können

Dann sollte das eigentlich funktionieren:
01.
Const Zeile1 = 10   'Hyperlink-Zeilen Begin 
02.
Const Spalte = "L"  'Hyperlink-Spalte 
03.
 
04.
Private Sub TestHyperlinks() 
05.
    Dim Fso As Object, c As Range, EndLine As Long 
06.
     
07.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
08.
     
09.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
10.
     
11.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
12.
        If c.Formula Like "*HIPERVINCULO*" And c.Text <> "" Then 
13.
            If Fso.FileExists(c) = False Then 
14.
                c.Offset(0, 1) = "x" 
15.
            Else 
16.
                c.Offset(0, 1) = "" 
17.
            End If 
18.
        End If 
19.
    Next 
20.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: mreske
04.12.2009 um 12:45 Uhr
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
Bitte warten ..
Mitglied: 76109
04.12.2009 um 12:58 Uhr
Hallo Mreske!

Yep, gern geschehen. Freut mich, dass es funktioniert

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 ist

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

Gruß Dieter
Bitte warten ..
Mitglied: mreske
04.12.2009 um 15:19 Uhr
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
Bitte warten ..
Mitglied: 76109
04.12.2009 um 16:18 Uhr
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 wenig

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

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

Vielen Dank für die Hilfe
Gruss
Mreske
Bitte warten ..
Mitglied: 76109
04.12.2009 um 20:49 Uhr
Hallo Mreske!

Hier nochmal komplett Version 1 <TestHyperlink> und <PrintPdf> wobei <Wenn True> der Pfad in Spalte L stehen muss.
01.
Option Explicit 
02.
 
03.
Const Zeile1 = 10   'Hyperlink-Zeilen Begin 
04.
Const Spalte = "L"  'Hyperlink-Spalte 
05.
 
06.
Const AcrobatReader = """D:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /p /h """ 
07.
 
08.
Private Sub TestHyperlinks_Click() 
09.
    Dim Fso As Object, c As Range, EndLine As Long 
10.
     
11.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
12.
     
13.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
14.
     
15.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
16.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
17.
            If Fso.FileExists(c) = False Then 
18.
                c.Offset(0, 1) = "x" 
19.
            Else 
20.
                c.Offset(0, 1) = "" 
21.
            End If 
22.
        End If 
23.
    Next 
24.
End Sub 
25.
 
26.
 
27.
Private Sub PrintPdf_Click() 
28.
    Dim Fso As Object, c As Range, EndLine As Long 
29.
     
30.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
31.
     
32.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
33.
     
34.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
35.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
36.
            If Fso.FileExists(c) = True Then 
37.
                Shell AcrobatReader & c & """", vbMinimizedNoFocus 
38.
            End If 
39.
        End If 
40.
    Next 
41.
End Sub
Hier Version 2 <TestHyperlink> und <PrintPdf> wobei Du wieder die ursprüngliche Formel verwenden kannst (Zellinhalt = "Link"):
01.
Option Explicit 
02.
 
03.
Const Zeile1 = 10           'Hyperlink-Zeilen Begin 
04.
Const Spalte = "L"          'Hyperlink-Spalte 
05.
 
06.
Const PdfName = "H"         'Spalte Pdf-Name 
07.
 
08.
'Pfad der Pdf-Dateien mit Variable (?) für Dateiname 
09.
Const PdfPfad = "W:\Personal\Manuel\Facturas_Vaude\?.pdf"  
10.
 
11.
Const AcrobatReader = """D:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /p /h """ 
12.
 
13.
Private Sub TestHyperlinks_Click() 
14.
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String 
15.
     
16.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
17.
     
18.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
19.
     
20.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
21.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
22.
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName)) 
23.
            If Fso.FileExists(Pdf) = False Then 
24.
                c.Offset(0, 1) = "x" 
25.
            Else 
26.
                c.Offset(0, 1) = "" 
27.
            End If 
28.
        End If 
29.
    Next 
30.
End Sub 
31.
 
32.
 
33.
Private Sub PrintPdf_Click() 
34.
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String 
35.
     
36.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
37.
     
38.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
39.
     
40.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
41.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
42.
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName)) 
43.
            If Fso.FileExists(Pdf) = True Then 
44.
                Shell AcrobatReader & Pdf & """", vbMinimizedNoFocus 
45.
            End If 
46.
        End If 
47.
    Next 
48.
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 muss

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

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
Bitte warten ..
Mitglied: mreske
09.12.2009 um 11:19 Uhr
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
Bitte warten ..
Mitglied: 76109
09.12.2009 um 11:30 Uhr
Hallo MReske!

Yepp, gern geschehen

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
Bitte warten ..
Mitglied: mreske
10.12.2009 um 10:12 Uhr
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
Bitte warten ..
Mitglied: 76109
10.12.2009 um 13:57 Uhr
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 Eile

Gruß Dieter
Bitte warten ..
Mitglied: mreske
11.12.2009 um 15:34 Uhr
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
Bitte warten ..
Mitglied: 76109
11.12.2009 um 18:59 Uhr
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.
Toll
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 Sache
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 versuchen

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

Gruß Dieter
Bitte warten ..
Mitglied: 76109
12.12.2009 um 10:52 Uhr
Hallo Manfred!

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

Version 1:
01.
Const PdfCopyPfad = "W:\Personal\Manuel\Facturas_Vaude_Copy" 
02.
 
03.
Private Sub CopyPdf_Click() 
04.
    Dim Fso As Object, c As Range, EndLine As Long 
05.
     
06.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
07.
     
08.
   'On Error Resume Next:  Fso.DeleteFolder PdfCopyPfad, True:  On Error GoTo 0 
09.
     
10.
   'Fso.CreateFolder PdfCopyPfad 
11.
 
12.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
13.
     
14.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
15.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
16.
            If Fso.FileExists(c) = True Then Fso.CopyFile c, PdfCopyPfad & "\" 
17.
        End If 
18.
    Next 
19.
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:
01.
Const PdfCopyPfad = "W:\Personal\Manuel\Facturas_Vaude_Copy" 
02.
 
03.
Private Sub CopyPdf_Click() 
04.
    Dim Fso As Object, c As Range, EndLine As Long, Pdf As String 
05.
     
06.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
07.
     
08.
   'On Error Resume Next:  Fso.DeleteFolder PdfCopyPfad, True:  On Error GoTo 0 
09.
     
10.
   'Fso.CreateFolder PdfCopyPfad 
11.
 
12.
    EndLine = Cells(Cells.Rows.Count, Spalte).End(xlUp).Row 
13.
     
14.
    For Each c In Range(Cells(Zeile1, Spalte), Cells(EndLine, Spalte)) 
15.
        If c.Formula Like "*HYPERLINK*" And c.Text <> "" Then 
16.
            Pdf = Replace(PdfPfad, "?", Cells(c.Row, PdfName)) 
17.
            If Fso.FileExists(Pdf) = True Then Fso.CopyFile Pdf, PdfCopyPfad & "\" 
18.
        End If 
19.
    Next 
20.
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 verwenden

Gruß Dieter
Bitte warten ..
Mitglied: mreske
14.12.2009 um 13:21 Uhr
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
Bitte warten ..
Mitglied: 76109
14.12.2009 um 16:33 Uhr
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 hat
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

Gruß Dieter
Bitte warten ..
Mitglied: Zwinckerchen
27.01.2010 um 13:16 Uhr
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
Bitte warten ..
Mitglied: 76109
27.01.2010 um 15:52 Uhr
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.
01.
    Dim StdDrucker As String 
02.
 
03.
    StdDrucker = Application.ActivePrinter 
04.
     
05.
    Application.ActivePrinter = "Druckername auf Ne00:" 
06.
     
07.
    Shell AcrobatReader..... 
08.
     
09.
    Application.ActivePrinter = StdDrucker
Den Namen des Standard-Druckers kannst Du mit dieser Routine auslesen:
01.
Sub GetStdPrinterName() 
02.
    MsgBox "Die Druckerbezeichnung: " & Application.ActivePrinter 
03.
End Sub
Drucker zum auslesen vorher als Standard-Drucker festlegen.

Gruß Dieter
Bitte warten ..
Mitglied: Zwinckerchen
28.01.2010 um 10:30 Uhr
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
Bitte warten ..
Mitglied: 76109
28.01.2010 um 15:14 Uhr
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
Bitte warten ..
Mitglied: 76109
28.01.2010 um 20:31 Uhr
Hallo Tine!

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

01.
Option Explicit 
02.
Option Compare Text 
03.
 
04.
Const strComputer = "." 
05.
 
06.
Const PdfPrinter = "Canon MX850 series Printer" 
07.
 
08.
Const ErrMsg = "Setzen des Standard-Druckers fehlgeschlagen" 
09.
 
10.
Private Sub PrintPdf() 
11.
    Dim StdPrinter As String 
12.
     
13.
    StdPrinter = GetStdPrinter 
14.
     
15.
    If SetStdPrinter(PdfPrinter) = False Then MsgBox ErrMsg, vbExclamation, "Fehler":  Exit Sub 
16.
     
17.
   'Pdf's drucken... 
18.
     
19.
    If SetStdPrinter(StdPrinter) = False Then MsgBox ErrMsg, vbExclamation, "Fehler" 
20.
End Sub 
21.
 
22.
Private Function GetStdPrinter() As String 
23.
    Dim objWMIService As Object, colItems As Object, objItem As Object 
24.
     
25.
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
26.
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", , 48) 
27.
     
28.
    For Each objItem In colItems 
29.
        If objItem.Default = True Then GetStdPrinter = objItem.Name:  Exit For 
30.
    Next 
31.
End Function 
32.
 
33.
Private Function SetStdPrinter(ByRef Printer) As Boolean 
34.
    Dim objWMIService As Object, colItems As Object, objItem As Object 
35.
     
36.
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
37.
    Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Printer", , 48) 
38.
     
39.
    For Each objItem In colItems 
40.
        If objItem.Name Like Printer Then objItem.SetDefaultPrinter:  SetStdPrinter = True:  Exit For 
41.
    Next 
42.
End Function
Falls beides USB-Drucker sind, kannst Du Sql-Anweisung auch ändern in:
01.
("SELECT * FROM Win32_Printer WHERE PortName LIKE 'USB%'", , 48)
Gruß Dieter
Bitte warten ..
Mitglied: Zwinckerchen
29.01.2010 um 12:32 Uhr
Hallo Dieter,
vielen, vielen Dank für die geduldige und ausführliche Hilfe: Ich habe es mit der Kommandozeilenvariante hinbekommen:

01.
                     
02.
Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " _ 
03.
                                & LinkAdresse & " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus 
04.
 
Ich musste ein paar Mal probieren, bis ich die Anführungszeichen richtig verteilt hatte, aber jetzt geht's - 1000 Dank!

Grüße
Tine
Bitte warten ..
Mitglied: Zwinckerchen
29.01.2010 um 12:48 Uhr
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:

01.
  For Each c In Range(Cells(ZeilenNr, 15), Cells(ZeilenNr, 28)) 
02.
            If c.Hyperlinks.Count And c.Text <> "" Then 
03.
            For Each Link In c.Hyperlinks 
04.
                LinkAdresse = "K:\testordner\" + Link.Address 
05.
                If Fso.FileExists(LinkAdresse) = True Then 
06.
                    Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " _  
07.
                               & LinkAdresse & " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus 
08.
                End If 
09.
            Next 
10.
            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
Bitte warten ..
Mitglied: 76109
29.01.2010 um 14:33 Uhr
Hallo Tine!

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

Die Schleifen würde ich in dem Fall so machen:
01.
For r = BegLine To EndLine 
02.
    For c = 15 To 28 
03.
        If Cells(r, c).Hyperlinks.Count Then 
04.
            LinkAdresse = "K:\testordner\" + Cells(r, c).Hyperlinks(1).Address 
05.
            If Fso.FileExists(LinkAdresse) = True Then 
06.
                Shell """C:\Programme\Adobe\Reader 9.0\Reader\AcroRd32.exe"" /t " & LinkAdresse & _ 
07.
                      " ""Druckername"" ""Druckertreiber"" ""Druckerport""", vbMinimizedNoFocus 
08.
            End If 
09.
        End If 
10.
    Next 
11.
Next
Dann wünsche ich Dir ein schönes WE


Gruß Dieter
Bitte warten ..
Mitglied: Zwinckerchen
29.01.2010 um 15:18 Uhr
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
Bitte warten ..
Mitglied: 76109
29.01.2010 um 15:48 Uhr
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
Bitte warten ..
Mitglied: Zwinckerchen
01.02.2010 um 09:59 Uhr
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:

01.
Private Sub AcroReaderBeenden() 
02.
  
03.
Dim objWMI As Object 
04.
Dim objProcess As Object 
05.
Dim colSystem As Object 
06.
  
07.
  
08.
Set objWMI = GetObject("winmgmts:") 
09.
Set colSystem = objWMI.InstancesOf("win32_process") 
10.
  
11.
For Each objProcess In colSystem 
12.
  If objProcess.Name = "AcroRd32.exe" Then 
13.
    objProcess.Terminate 
14.
  End If 
15.
Next 
16.
  
17.
Set colSystem = Nothing 
18.
Set objProcess = Nothing 
19.
Set objWMI = Nothing 
20.
  
21.
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
Bitte warten ..
Mitglied: 76109
01.02.2010 um 19:24 Uhr
Hallo Tine!

Naja, wenigstens funktioniert das Ganze Wenn auch nicht so, wie ich mir das vorgestellt hatte.

Danke für die Hinweise

Gruß Dieter
Bitte warten ..
Neuester Wissensbeitrag
Ähnliche Inhalte
Microsoft Office
gelöst Excel Makro : Erst prüfen bei erfolgreicher IF einen Wert überschreiben (4)

Frage von Matze1508 zum Thema Microsoft Office ...

Microsoft Office
gelöst Excel-Formel oder VBA (7)

Frage von nicki01 zum Thema Microsoft Office ...

VB for Applications
Excel VBA Sortierung von Daten (5)

Frage von easy4breezy zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (33)

Frage von patz223 zum Thema Windows Userverwaltung ...

LAN, WAN, Wireless
FritzBox, zwei Server, verschiedene Netze (21)

Frage von DavidGl zum Thema LAN, WAN, Wireless ...

Viren und Trojaner
Aufgepasst: Neue Ransomware Goldeneye verbreitet sich rasant (20)

Link von Penny.Cilin zum Thema Viren und Trojaner ...

Windows Netzwerk
Windows 10 RDP geht nicht (18)

Frage von Fiasko zum Thema Windows Netzwerk ...