Anzeige
Archiv - Navigation
276to280
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
276to280
276to280
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

bild anzeigen per vba

bild anzeigen per vba
06.07.2003 09:23:31
willi
Hallo,
als Sammler habe ich eine größere Anzahl von Gläsern. Nun habe ich in einer Excel Tabelle dieses Gläser untereinander aufgelistet und möchte in einer bestimmten Zelle (nicht durch ein externes Programm) das zugehörige Bild anzeigen. Das Bild soll nur durch Aktivierung der Zelle angezeigt werden, nicht durch einen extra Button. Wenn ich die nächste Zelle aktiviere, soll das vorherige Bild gelöscht und das aktuelle angezeigt werden.
Da ich in VBA nicht gewandert bin, hoffe ich auf Euere Hilfe.
Gruß Willi

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bild anzeigen per vba
06.07.2003 21:11:45
willi
Hallo Ivan,
ich erhalte sofort die Fehlermeldung:
Columns(1).ClearContents
"Fehler beim Kompilieren. Außerhalb einer Prozedur ungültig."
Mache ich was falsch?
Willi

AW: bild anzeigen per vba
06.07.2003 11:51:41
ivan
HI WILLI
wie wäre es mit hyperlinks???
'Verzeichniss einlesen als Hyperlink

Private Sub Refresh_Click()
Dim strInitialDir As String, strPath As String
Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer
Columns(1).ClearContents
sPath = BrowseDirectory()
If sPath = "" Then Exit Sub
'einlesen
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPattern = "*.*"'statt dem 2.stern kann man die datei endung eingeben
sFile = Dir(sPath & sPattern)
Do Until sFile = ""
iRow = iRow + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 1), _
Address:=sPath & sFile, TextToDisplay:=sFile
sFile = Dir()
Loop
End Sub

damit kanst du alle bilder per verzeichnissbaum als
hyperlink einlesen.ein klick auf das bild öffnet dann das bild.
wenn du möchtest schick ich dir den 2 teil des codes.
damit du den verzeichnissbaum öffnen kannst.


Anzeige
AW: bild anzeigen per vba
06.07.2003 16:04:06
willi
Hi Ivan,
kannst Du bitte etwas genauer erläutern, wie dein Script gemeint ist und was ich machen muß, damit ein Bild erscheint?
Wie gesagt, ich habe von vba kaum eine Ahnung.
Gruß
Willi

AW: bild anzeigen per vba
06.07.2003 18:08:52
ivan
hi
erstelle einen commandbutton1 in der tabelle1
dann drücke Alt+f11
im menü einfügen modul einfügen
in dieses modul1 kopierst du diesen code
wenn du das hast dann melde dich wieder!"
Private Commandbutton1_Click()
Dim strInitialDir As String, strPath As String
Dim sFile As String, sPattern As String, sPath As String
Dim iRow As Integer
Columns(1).ClearContents
sPath = BrowseDirectory()
If sPath = "" Then Exit Sub
'einlesen
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sPattern = "*.*"'statt dem 2.stern kann man die datei endung eingeben
sFile = Dir(sPath & sPattern)
Do Until sFile = ""
iRow = iRow + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(iRow, 1), _
Address:=sPath & sFile, TextToDisplay:=sFile
sFile = Dir()
Loop
End Sub

Anzeige
AW: bild anzeigen per vba
06.07.2003 20:23:13
willi
Hallo Ivan,
soweit erledigt. Was folgt als nächstes?
Willi

AW: bild anzeigen per vba
06.07.2003 20:39:34
ivan
hi
na super jetzt das Finale!
also ganz einfach,
erstelle ein neues modul2
kopiere den code in modul2
danach klick den commandbutton1 an und gib dein verzeichniss an wo
deine bilder liegen.danch hast du alle bilder in der mappe.
fertig
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" _
(ByVal szPath As String) As Long
Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const BIF_DONTGOBELOWDOMAIN As Long = 2
Private Const BFFM_INITIALIZED As Long = 1
Private Const MAX_PATH As Long = 260
Private Const WM_USER As Long = &H400
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Private Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
' Callback für die Browse-Directory-Methode - "pidList"-Methode
' zur Verwendung in der BrowseDirectory()-Funktion

Private Function BrowseCallBackProc(ByVal hWnd As Long, _
ByVal uMsg As Long, ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Voreinstellung des Verzeichnisses im Verzeichnis-
'Dialog unter Verwendung des Parameters "pidList"
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
Case Else
End Select
End Function

' Dummy-Methode, um den Inhalt des AddressOf-Operators zu erhalten und
' zur Verwendung in der BrowseDirectory()-Funktion zurückzugeben

Private Function FARPROC(pfn As Long) As Long
'Einstellen und Erhalten der Adresse für ein Callback. Das ist notwendig,
'weil man "AddressOf" nicht direkt einem benutzerdefinierten Typ zuweisen
'kann. Man kann es aber einer anderen Variablen vom Typ "Long" zuweisen,
'der - wie hier auch von der Function zurückgegeben - weiter verwendet
'werden kann.
FARPROC = pfn
End Function

' "pidList"-Parameter für den vorgegebenen Pfad wird durch den Aufruf
' der undokumenteierten API-Funktion #162 zurückgegeben.

Private Function GetPIDLFromPath(ByVal sPath As String) As Long
'If IsWinNT Then
GetPIDLFromPath = SHSimpleIDListFromPath(StrConv(sPath, vbUnicode))
'Else
'    GetPIDLFromPath = SHSimpleIDListFromPath(sPath)
'End If
End Function

Public Function BrowseDirectory(Optional ByVal strInitialDir As String, Optional ByVal _
hWnd As Long) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
szTitle = "Please select a directory"
With tBrowseInfo
.hwndOwner = hWnd
.pidlRoot = 0
.lpszTitle = szTitle
' .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
.lpfnCallback = FARPROC(AddressOf BrowseCallBackProc)
.lParam = GetPIDLFromPath(strInitialDir)
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseDirectory = sBuffer
' Ressourcen freigeben
CoTaskMemFree lpIDList
Else
BrowseDirectory = strInitialDir
End If
' Ressourcen freigeben
CoTaskMemFree tBrowseInfo.lParam
End Function

Sub OrdnerAuswahl()
Dim strInitialDir As String, strPath As String

strPath = BrowseDirectory()

End Sub

'Verzeichnisdialog mit Voreinstellung anzeigen
' strInitialDir = "C:\Daten"
' strPath = BrowseDirectory(strInitialDir)

'Verzeichnisdialog ohne Voreinstellung verwenden
viel spass
ivan

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige