hier eine vereinfachte Version:
Private Declare Function PostMessage Lib „user32“ Alias „PostMessageA“ (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function OpenProcess Lib „kernel32“ _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib „user32“ _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
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
Private Declare Function SetForegroundWindow Lib „user32“ (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib „user32“ Alias „FindWindowA“ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib „user32“ (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Option Explicit
Sub ausgangsfilesLaden()
Dim pfad
Dim i
Range(„A2:Z10000“).Clear
Cells(1, 9).Clear
Verzeichniswahl
pfad = Cells(1, 9).Value
Dim MyFile As String
i = 2
MyFile = Dir$(pfad & „*.jpg“)
Do
Cells(i, 1).Value = MyFile
i = i + 1
MyFile = Dir
Loop Until MyFile = „“
End Sub
Sub filesOeffnenUndDatenEinlesen()
Dim pfad
Dim name
Dim bild
Dim wert
Dim merk
Dim i
pfad = Cells(1, 9).Value
name = ActiveWorkbook.name
i = 2
Do While (Cells(i, 1).Value „“)
Cells(i, 1).Select
merk = Selection.Value
bild = pfad & „“ & merk
wert = ShellExecute(0, „open“, bild, „“, „c:“, 3)
aktivieren (name)
Cells(i, 2).Select
UserForm1.Show 1
schliessen merk
i = i + 1
Loop
End Sub
Function schliessen(merk)
Dim hWindow As Long
Dim hThread As Long
Dim hProcess As Long
Dim lProcessId As Long
Dim lngReturnValue As Long
hWindow = FindWindow(vbNullString, „Microsoft Office Picture Manager“)
hThread = GetWindowThreadProcessId(hWindow, lProcessId)
hProcess = OpenProcess(&H100000, 0&, lProcessId)
lngReturnValue = PostMessage(hWindow, &H10, 0&, 0&:wink:
End Function
Function aktivieren(merk)
Dim hwnd As Long
hwnd = FindWindow(vbNullString, "Microsoft Excel - " & merk)
If hwnd 0 Then
SetForegroundWindow hwnd
End If
End Function
Function Verzeichniswahl()
Dim objShell
Dim objFolder
Dim pfad
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject(„Shell.Application“)
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, „Select a folder:“, NO_OPTIONS, „“)
On Error Resume Next
pfad = objFolder.self.Path
If IsEmpty(pfad) Then
End
Else
Cells(1, 9).Value = pfad
End If
End Function
Zusätzlich brauchst du ein UserForm1 mit einem Button zum schließen. Der Code:
Private Sub CommandButton1_Click()
UserForm1.Hide
End Sub
Mit „ausgangsfilesLaden“ kannst du nach einem Ordner suchen, in dem die Fotos sind --> Die Pfade werden in die erste Spalte geschrieben
Mit „filesOeffnenUndDatenEinlesen“ werden diese dann wie beschrieben geöffnet und das UserForm 1 wird geladen. In einem anderen Modul wird bei mir auch noch die Fensteranordnung so gestaltet, dass Excel die eine Hälfte des Monitors und das Foto die andere einnimmt.
Vielen Dank im Vorraus,
lg
