AW: Makro Öffnen 1 jpg Datei gesucht - Frage leicht geändert
31.08.2024 14:49:30
volti
Hallo RoWaLo,
Fall 3:
Die Ermittlung des Ordners, in dem die Exceldatei gespeichert ist, lautet:
sVerz = Thisworkbook.path
Das wäre also kein Problem und m.E. die beste Lösung, weil unabhängig vom Dateibereitsteller aber schon etwas strukturiert...
Fall 4:
Die Ermittlung über den gesamten PC sollte, wie Ulf schon schrieb, wegen der Zeit vermieden werden.
Wenn ein Startordner vorgegeben wird, wie Du schon vorgeschlagen hast, ist die benötigte Zeit m.E. hinnehmbar, so langsam ist das nun auch wieder nicht.
Bloß kein gesamtes C: mit den ganzen App-Daten....
Aber natürlich,
- schaut man erst, ob Fall 3 schon zum Ziel führt.
- führt man dann bei Bedarf den Scan durch und falls der wirklich unannehmbar lang sein sollte:
- könnte man die Datei ja per VBA (falls erlaubt) in ein bekanntes Verzeichnis verschieben, so dass der Scan nur einmalig wäre
- oder (falls Exceldatei beim User gespeichert werden sollte) der Speicherort des Bildes wird in der Exceldatei irgendwo abgelegt, so dass der Scan nur einmalig wäre
- oder der Pfad wird in einer INI-Datei (kleine Textdatei) gespeichert und im TEMP-Verzeichnis abgelegt. (Den hat jeder)
- oder noch was anderes
Als Service sollte die Bilddatei per VBA aufgerufen werden, man muss das ja nicht den Usern aufbürden 😎
Hierzu hatte ich Dir ja schon die Lösung via Shellexecute aufgezeigt.
Shellexecute öffnet die übergebende Nutzdatei anhand der Erweiterung (Suffix) wie .doc, .jpg, .htm usw. mit der dafür registrierten App.
Im Gegensatz zu Shell braucht man hier nicht den Pfad und den Anwendungsnamen kennen.
Deshalb sollte das Öffnen der Bilddatei auch bei jedem anderen User funktionieren.
Auch das hälftige Ausrichten kann per VBA durchgeführt.
Hier zum Abschluss eine Idee dazu. Diese Version ist minimal und erfordert, dass zunächst Excel im Vordergrund ist.
AdjustWindows erlaubt die Positionierung links/rechts wie rechts/links. Kann man auch noch kürzen....
Code:
Private Declare PtrSafe Function ShellExecuteA Lib "Shell32.dll" ( _
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
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function SetWindowPos Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" ( _
ByVal RootPath As String, ByVal InputPathName As String, _
ByVal InputPathBuffer As String) As Long
Private Function SucheDatei(sDatei As String, sStartVerz As String) As Boolean
Dim sBuffer As String * 256
If SearchTreeForFile(sStartVerz, sDatei, sBuffer) <> 0 Then
sDatei = sStartVerz & Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)
SucheDatei = True: Exit Function
End If
End Function
Private Sub AdjustWindows(iRichtung As Integer)
Dim i As Long, cx As Long, cy As Long, hWnd(1) As LongPtr
Const SWP_SHOWWINDOW As Long = &H40
' Excel-Fenster auf die gewünschte Bildschirmhälfte setzen
cx = GetSystemMetrics(0) \ 2: cy = GetSystemMetrics(1)
hWnd(0) = Application.hWnd
Do
i = i + 1: If i > 100 Then Exit Sub
Sleep 100: DoEvents
hWnd(1) = GetForegroundWindow
Loop Until hWnd(1) <> hWnd(0) And hWnd(1) <> 0
' Fenster ausrichten (Nur wenn Externes Fenster gefunden)
For i = 0 To 1
SetWindowPos hWnd(i), 0, cx * Abs(i - iRichtung), 0, cx, cy, SWP_SHOWWINDOW
Next i
End Sub
'#### Aufruftest ###
Sub Test()
Dim sDatei As String
sDatei = ThisWorkbook.FullName
sDatei = Left$(sDatei, InStrRev(sDatei, ".")) & "jpg" ' Wenn Bilddatei wie Excel heißt
If Dir$(sDatei) = "" Then
sDatei = Mid$(sDatei, InStrRev(sDatei, "\") + 1) ' Wenn Bilddatei wie Excel heißt
If SucheDatei(sDatei, "E:\Bilder zu Excel\") = False Then Exit Sub
End If
If Dir$(sDatei) <> "" Then
ShellExecuteA 0&, "Open", sDatei, 0, 0, &H9& '9=SW_RESTORE
Call AdjustWindows(1)
End If
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz