Registriert seit: 26.03.2019
Version(en): 2010
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?
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
Hallo,
mit welchem Standardbrowser arbeitest du?
________
Servus
Case
Registriert seit: 26.03.2019
Version(en): 2010
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
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
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.
________
Servus
Case
Registriert seit: 26.03.2019
Version(en): 2010
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
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
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.
________
Servus
Case
Registriert seit: 26.03.2019
Version(en): 2010
12.02.2022, 17:41
(Dieser Beitrag wurde zuletzt bearbeitet: 13.02.2022, 07:38 von schauan.)
Dann bin ich mal so frei und share das einfach :)
Danke für deine Hilfe !
Registriert seit: 30.08.2014
Version(en): Office 365 - Beta 32 Bit
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.
________
Servus
Case
Folgende(r) 1 Nutzer sagt Danke an Case für diesen Beitrag:1 Nutzer sagt Danke an Case für diesen Beitrag 28
• Luk1154
Registriert seit: 26.03.2019
Version(en): 2010
Ich hab selbst ein Fehler in meiner Logik gehabt, danke!
Tut :)
Registriert seit: 26.03.2019
Version(en): 2010
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
|