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?
Hallo,
mit welchem Standardbrowser arbeitest du?
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
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.
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
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.
Dann bin ich mal so frei und share das einfach :)
Danke für deine Hilfe !
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.
Ich hab selbst ein Fehler in meiner Logik gehabt, danke!
Tut :)
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