Excel Hyperlink

[Luk1154]

Hallo,

ich habe schon viel Probiert und Google gefragt, finde aber leide keine funktioniernde Lösung. 

Es geht mir um den Bereich von Spalte B5 bis Spalte B200

In diesem Bereich ist folgende Formel hinterlegt: =WENN($A11="";"Bitte Stammnummer eintragen";HYPERLINK(TEXTKETTE($B$1;$A11;$B$2)))

Wenn also jemand die Stammnummer einträgt wird ein Link generiert, dieser fängt an mit "https://"

Ich möchte gerne ein Makro haben, welches im Bereich von B5 bis B200, sofern er Inhalt mit https:// anfängt, die Hyperlinks nach einander öffnet (Website), am liebsten in Tabs und nicht neuen Fenstern.

Oder immer ein Hyperlink, 5 Sekunden warten, fenster schließen, nächster hyperlink.

Geht das irgendwie?

[00202]

Hallo,  

mit welchem Standardbrowser arbeitest du?

[Luk1154]

Hallo,

Windows "Standard" bzw. Edge, manchmal auch Firefox. ist das relevant?

Wenn ich den Hyperlink so anklicke wählt der ja auch automatisch den Standard-Browser aus, muss man das in VBA hinterlegen?

Grüße
Luk1154

[00202]

Hallo,  

prinzipiell so:

Code:

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#Else
Private Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As Long, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private Const SW_MAXIMIZE = 3&
Public Sub Main()
    Dim lngTMP As Long
    On Error GoTo Fin
    For lngTMP = 5 To 200
        With ThisWorkbook.Worksheets("Tabelle1") ' Tabellenblattname anpassen!!!
            If LCase(Left(.Cells(lngTMP, 2).Value, 5)) = "https" Then
                ShellExecute 0, "open", .Cells(lngTMP, 2).Value, vbNullString, vbNullString, SW_MAXIMIZE
                Call Sleep(5000) '5 Sekunden !!!
                Shell "wmic Process where ""name like '%edg%'"" call terminate", vbHide
                'Shell "wmic Process where ""name like '%fire%'"" call terminate", vbHide
            End If
        End With
    Next lngTMP
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub

Die Codezeile mit dem abschiessen des Prozesses kannst du natürlich auch nach dem "Next lngTMP" einsetzen. Dann wird erst am Schluss alles geschlossen.

Mach einfach was draus.

[Luk1154]

Hallo,

cool - das tut zumindest zu einem gewissen Grad, er öffnet nur einen Hyperlink bzw. ein Download und hört dann auf. Aber er soll ja jeden Link der mit Https anfängt von B5 bis runter zu B200 aufmachen und danach Fenster wieder schließen.

zwischenurch hat er auch datein die wie folgt heissen -> 55555.png.crdownload   der letzte Teil erscheint mir komisch.

Grüße
Luk1154

[00202]

Hallo,  

in meiner Beispieldatei klappt alles. Zu deiner Datei kann ich logischerweise nichts sagen.

Im Moment killt der Code den Edge. Die auskommentierte Codezeile drunter ist für den Firefox.

[Luk1154]

Dann bin ich mal so frei und share das einfach :)

Danke für deine Hilfe !

[00202]

Hallo,  

also bei mir ist der FireFox Standard und folgender Code lief anstandslos durch:  

Code:

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#Else
Private Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As Long, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private Const SW_MAXIMIZE = 3&
Public Sub Main()
    Dim lngTMP As Long
    On Error GoTo Fin
    For lngTMP = 5 To 200
        With ThisWorkbook.Worksheets("Tabelle1") ' Tabellenblattname anpassen!!!
            If LCase(Left(.Cells(lngTMP, 2).Value, 5)) = "https" Then
                ShellExecute 0, "open", .Cells(lngTMP, 2).Value, vbNullString, vbNullString, SW_MAXIMIZE
                Call Sleep(5000) '5 Sekunden !!!
            End If
        End With
    Next lngTMP
    'Shell "wmic Process where ""name like '%edg%'"" call terminate", vbHide
    Shell "wmic Process where ""name like '%fire%'"" call terminate", vbHide
Fin:
    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub

Eventuell kannst du ja noch die 5 Sekunden erhöhen.

Die Datei "55555.png" mit 3.448 KB war dann zweimal da - nach Klick auf "Download". Am Schluss wird der Browser dann komplett geschlossen.

[Luk1154]

Ich hab selbst ein Fehler in meiner Logik gehabt, danke!

Tut :)

[Luk1154]

Hey,

letzte Frage...ich hab das jetzt an mehreren PCs getestet und das funktioniert jetzt auch echt Bombe und genau so wie ich es mir vorgestellt habe.

Nur an einem punkt hänge ich manchmal. Je nachdem muss ich manchmal den Download vom Bild noch manuell bestätigen und manchmal nicht...kann man das irgenwdie umgehen bzw. lösen?

Grüße