Office: (Office 2003) Bilddatei öffnen aus VBA

Rechner63 · 13. Dezember 2006

Hallo Leute,
habe folgendes Problem: Ich möcht aus einem Formular heraus per VBA ein JPG mit der Windows Bild und Faxanzeige öffnen. Wenn ich eine Tabelle erstelle mit dem Inhalt OLE-Paket und in der Tabellenansicht darauf Doppelklicke, funktioniert das. Ich möchte dies nun aber per Code erreichen.

Hoffe es kann jemand weiterhelfen.

:)

Struppi73 · 16. Dezember 2006

Du möchtest eine JPG-Datei auf der Festplatte öffnen? Und der komplette Pfad der Datei liegt dir als String in deiner Datenbank vor? Du möchtest irgendwo im Formular auf diesen String klicken, so dass sich die JPG-Datei öffnet?

Struppi73 · 16. Dezember 2006

Eine sofortige Lösung, falls meine o. g. Annahme so zutrifft. Basiert komplett auf API, liefert dir aber dafür das vertraute Windows Look´n Feel, und funktioniert darüber hinaus nicht nur mit JPG, sondern mit beliebigen Dateien.

Es wird versucht, eine Datei, deren kompletter Pfad bekannt ist, mit der in Windows verknüpften Anwendung zu öffnen. Ist keine Anwendung verknüpft, wird der "Öffnen mit..."-Dialog angezeigt, im Fehlerfall eine entsprechende fehlermeldung ausgegeben.

Erzeuge ein neues Modul, und füge folgende Deklarationen ein:
Code:

Private Const MAX_PATH = 260

'Icon IDs
Private Const MB_ICONHAND As Long = &H10&

'Button IDs
Private Const MB_RETRYCANCEL As Long = &H5&

'Msgbox style IDs
'modality
Private Const MB_TOPMOST As Long = &H40000

'wLanguageId parameter IDs
Private Const LANG_ENGLISH As Long = &H9

'Return values
Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

'APIs
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" ( _
ByVal lpszLongPath As String, ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () _
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 GetSystemDirectory Lib "kernel32" _
Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long

Private Declare Function MessageBoxEx Lib "user32" _
Alias "MessageBoxExA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageId As Long) As Long
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dann füge noch folgende zwei Funktionen hinzu, die eine privat, die andere public:
Code:

' liefert zu einem ErrorCode der API ShellExecute die passende ErrorMessage
Private Function SE_ErrMessage(ByVal lngErrCode&) As String

Select Case lngErrCode
Case 0: SE_ErrMessage = "Zuwenig Speicher, ausführbare Datei war zerstört, Relokationswerte waren ungültig"
Case 2: SE_ErrMessage = "Datei wurde nicht gefunden."
Case 3: SE_ErrMessage = "Verzeichnis wurde nicht gefunden."
Case 5: SE_ErrMessage = "Fehler beim gemeinsamen Zugriff auf eine Datei im Netz oder Fehler beim Zugriff auf eine gesperrte Datei im Netz."
Case 6: SE_ErrMessage = "Bibliothek forderte separate Datensegmente für jede Task an."
Case 8: SE_ErrMessage = "Zuwenig Speicher, um die Anwendung zu starten."
Case 10: SE_ErrMessage = "Falsche Windows-Version."
Case 11: SE_ErrMessage = "Ungültige ausführbare Datei. Entweder keine Windows-Anwendung oder Fehler in der EXE-Datei."
Case 12: SE_ErrMessage = "Anwendung für ein anderes Betriebssystem."
Case 13: SE_ErrMessage = "Anwendung für MS-DOS 4.0."
Case 14: SE_ErrMessage = "Typ der ausführbaren Datei unbekannt."
Case 15: SE_ErrMessage = "Versuch, eine Real-Mode-Anwendung (für eine frühere Windows-Version) zu laden."
Case 16: SE_ErrMessage = "Versuch, eine zweite Instanz einer ausführbaren Datei mit mehreren Datensegmenten die nicht als nur lesbar gekennzeichnet waren, zu laden."
Case 19: SE_ErrMessage = "Versuch, eine komprimierte ausführbare Datei zu laden.' + #13 + 'Die Datei muß dekomprimiert werden, bevor sie geladen werden kann."
Case 20: SE_ErrMessage = "Ungültige dynamische Linkbibliothek (DLL).' + #13 + 'Eine der DLLs, die benötigt wurde, um die Anwendung auszuführen, war beschädigt."
Case Else: SE_ErrMessage = "Ein Unbekannter Fehler ist aufgetreten."
End Select
End Function

' versucht per API ShellExecute die mit der Datei verknüpfte Anwendung zu starten
' Wenn die Dateierweiterung noch nicht bekannt ist, wird der "Öffnen mit..."-Dialog angezeigt
' ansonsten eine entsprechende Fehlermeldung
' Alles in allem das vertraute Windows-Look´n Feel!
Public Function ÖffneDatei(ByRef sDateiPfad As String) As Boolean

Dim path$, Err&
Dim sMessage$, sTitle$, dwFlags$
Dim sDirectory$, lRet&, DeskWin&

Retry:

ÖffneDatei = True

' Versuch, die mit der Datei verknüpfte Anwendung zu starten
path = Space(MAX_PATH)
Call GetShortPathName(sDateiPfad, path, MAX_PATH)
DeskWin = GetDesktopWindow()
Err = ShellExecute(DeskWin, "Open", path, "", vbNullString, 1)

'# Fehlerbehandlung #
'Wenn die Dateierweiterung noch nicht bekannt ist...
'wird der "Öffnen mit..."-Dialog angezeigt
If Err = "31" Then

sDirectory = Space(MAX_PATH)
lRet = GetSystemDirectory(sDirectory, Len(sDirectory))
sDirectory = Left(sDirectory, lRet)
Call ShellExecute(DeskWin, vbNullString, _
"RUNDLL32.EXE", "shell32.dll,OpenAs_RunDLL " & _
path, sDirectory, vbNormalFocus)

'Sonstige Fehler
ElseIf Err "42" Then

ÖffneDatei = False

sMessage = sDateiPfad & " kann nicht geöffnet werden." & vbLf & SE_ErrMessage(Err)
sTitle = "Explorer - " & path
dwFlags = MB_ICONHAND Or MB_RETRYCANCEL Or MB_TOPMOST
Select Case MessageBoxEx(Screen.ActiveForm.hwnd, _
sMessage, _
sTitle, _
dwFlags, _
LANG_ENGLISH)

Case IDOK:
Case IDCANCEL:
Case IDABORT:
Case IDRETRY: GoTo Retry
Case IDIGNORE:
Case IDYES:
Case IDNO:
End Select
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Verwendung (Öffnen der Datei "C:\beispiel.jpg"):
Code:

Dim bResult as Boolean
bResult = ÖffneDatei("C:\beispiel.jpg")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Funktion "ÖffneDatei" liefert als Funktionsergebnis True, wenn sich die Datei öffnen lies oder der "Öffnen mit..." Dialog angezeigt wurde, ansonsten False.

Rechner63 · 16. Dezember 2006

Im Prinzip ja. Zur Erklärung: Datenbank mit Ersatzteilen. Jedes Ersatzteilblatt hat eine Nummer und eine dazu gehörige Sprengzeichnung. Wenn ein Ersatzeilblatt angezeigt wird, möchte ich die Option geben per Klick auf einen Button die entsprechende Zeichnung Anzuzeigen. Pfad und Name des JPG ist bekannt. Mit Bild und Faxanzeige wäre ideal, da ich dort einfach zoomen kann, und da es Blääter gibt, die so umfangreich sind, das es dazu mehrere Zeichnungen gibt. Wenn ich nun die Zeichnungen nach Nummern in einzelne Verzeichnisse lege, könnte ich auch durch Mehrfachzeichnungen blättern. Ich hoffe es ist zu verstehen, was ich vor habe.

Rechner63 · 16. Dezember 2006

War beim Tippen wohl etwas zu langsam. Funktioniert einwandfrei!

Vielen Dank für die Hilfe!

cu

DV-Fan · 7. August 2007

Hallo

wollte die Funktion auch nutzen habe es so gemacht aber folgende Fehlermeldung kommt (siehe Grafik)

Die Funkion GetShortPathName habe ich wie beschrieben im Extramodul deklariert

Sascha Trowitzsch · 7. August 2007

Nicht in einem Extramodul, sondern im gleichen!
Die APIs von Struppi oben sind alle als Private deklariert!

Ciao, Sascha

DV-Fan · 8. August 2007

Achso
OK jetzt gehts
Danke schön

Office: (Office 2003) Bilddatei öffnen aus VBA

Bilddatei öffnen aus VBA

Bilddatei öffnen aus VBA

Bilddatei öffnen aus VBA

Bilddatei öffnen aus VBA

Bilddatei öffnen aus VBA - Similar Threads - Bilddatei öffnen VBA

DropDown öffnen bei anwählen (.Select) einer Zelle

8.000 URL-Bilddateien aus Excel exportieren

Vorschau auf pdf und Bilddateien

Änderungen am Format beim Verschicken von Bilddateien?

Ein Feld mit einer Bilddatei verknüpfen ...

Autobeschriftung für diverse Bilddateien

Dateinvorschau (Bilddateien) geht nicht mehr!