Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen

Hyperlink setzen | Herbers Excel-Forum


Betrifft: Hyperlink setzen von: Snewi
Geschrieben am: 22.10.2008 13:43:51

Hallo,

wie kann ich über eine Forms ein Bild aus einem Ordner hochladen und dann den Pfad als Hyperlink in eine Zelle schreiben? Wenn ich dann den Link anklicke soll in einem extra Fenster das Bild zu sehen sein!
Ist das in VBA möglich?

Gruß

  

Betrifft: AW: Hyperlink setzen von: rofu
Geschrieben am: 22.10.2008 15:09:36

'############################################################################################'
' Die folgenden Makros" BILDER " durchsuchen einen Ordner und seine Unterordner '
'############################################################################################'
'Dieser Bereich kann entfallen, wenn der Variable 'Laufwerk' ein fester Wert zugewiesen wird.'
Public Type BROWSEINFO '
hOwner As Long '
pidlRoot As Long '
pszDisplayName As String '
lpszTitle As String '
ulFlags As Long '
lpfn As Long '
lParam As Long '
iImage As Long '
End Type '
Declare

Function SHGetPathFromIDList Lib "SHELL32.DLL" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "SHELL32.DLL" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Msg) As String
    Dim myInfo As BROWSEINFO
    Dim myPath As String
    Dim Root As Long, ID As Long, pos As Integer
    With myInfo
        .pidlRoot = 0&
        .lpszTitle = Msg
        .ulFlags = &H1
    End With
    ID = SHBrowseForFolder(myInfo)
    myPath = Space$(512)
    Root = SHGetPathFromIDList(ByVal ID, ByVal myPath)
    If Root Then
        pos = InStr(myPath, Chr$(0))
        GetDirectory = Left(myPath, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function


Sub BILDER()
Dim ordner As String
Dim oBilder As Worksheet
Dim FS As FileSearch
Dim sName As String
Application.ScreenUpdating = False
'VEREINBARUNGEN:
'Name des Bildauswahlblattes
sName = "Bildauswahl"
'Name des Orners
Dim Msg As String, myPath As String
Msg = "Wähle ein Verzeichnis aus," & Chr(13) & "aus dem Bilder angezeigt werden sollen:"
myPath = GetDirectory(Msg)
If myPath = "" Then
Exit Sub
Else
ordner = myPath
Set FS = Application.FileSearch
With FS
    .NewSearch
    .LookIn = ordner
    .SearchSubFolders = False
    .FileType = msoFileTypeAllFiles
    .Execute
End With

'BLATT ERSTELLEN UND EINRICHTEN
On Error GoTo fehler
Set oBilder = Worksheets.Add
oBilder.Name = sName
'Blattkopf
oBilder.Cells(1, 1).Value = "Bilder aus " & ordner
oBilder.Cells(2, 1).Value = "Vorschau"
oBilder.Cells(2, 2).Value = "Link"
With oBilder.Cells(1, 1).Font
    .Bold = True
    .Size = .Size + 4
End With
With oBilder.Range(Cells(2, 1), Cells(2, 2)).Font
    .Bold = True
    .Size = .Size + 2
End With

'DATEIEN AUS ORDNER EINLESEN
On Error GoTo 0
Dim iZeile As Integer
iZeile = 4
For i = 1 To FS.FoundFiles.Count
'Vereinbarung der Typen, die gesucht werden können
    If FS.FoundFiles(i) Like "*.jpg" Or _
        FS.FoundFiles(i) Like "*.JPG" Or _
        FS.FoundFiles(i) Like "*.tif" Or _
        FS.FoundFiles(i) Like "*.TIF" Or _
        FS.FoundFiles(i) Like "*.gif" Or _
        FS.FoundFiles(i) Like "*.GIF" Or _
        FS.FoundFiles(i) Like "*.png" Or _
        FS.FoundFiles(i) Like "*.PNG" Or _
        FS.FoundFiles(i) Like "*.jp2" Or _
        FS.FoundFiles(i) Like "*.JP2" Or _
        FS.FoundFiles(i) Like "*.ico" Or _
        FS.FoundFiles(i) Like "*.ICO" Or _
        FS.FoundFiles(i) Like "*.emf" Or _
        FS.FoundFiles(i) Like "*.EMF" Or _
        FS.FoundFiles(i) Like "*.bmp" Or _
        FS.FoundFiles(i) Like "*.BMP" Then
        'Festsetzung von Bild- und Zeilenhöhe
        oBilder.Rows(iZeile).RowHeight = 50
        'Text vertikal mittig in Zeile
        oBilder.Rows(iZeile).VerticalAlignment = xlVAlignCenter
        'gefundenes Bild einfügen und Höhe auf Zeilenhöhe setzen
        oBilder.Cells(iZeile, 1).Select
        ActiveSheet.Pictures.Insert(FS.FoundFiles(i)).Select
        With Selection.ShapeRange
            .LockAspectRatio = msoTrue
            .Height = 50
            oBilder.Hyperlinks.Add Anchor:=.Item(1), Address:=FS.FoundFiles(i)
        End With
        'maximale Breite merken
        If Selection.ShapeRange.Width > maxWidth Then _
            maxWidth = Selection.ShapeRange.Width
        'Hyperlink mit Dateinamen in Spalte B
        oBilder.Hyperlinks.Add Anchor:=oBilder.Cells(iZeile, 2), _
            Address:=FS.FoundFiles(i), _
            TextToDisplay:=FS.FoundFiles(i), _
            ScreenTip:="Hier klicken, um das Bild anzuzeigen ..."
        'Zeilenzähler hochsetzen
        iZeile = iZeile + 2
    End If
Next
'Breite der 1. Spalte auf max. Breite, der 2. Spalte auf optimale Breite
maxWidth = maxWidth * oBilder.Columns(1).ColumnWidth / _
    oBilder.Columns(1).Width + 5
If maxWidth > 255 Then maxWidth = 255
oBilder.Columns(1).ColumnWidth = maxWidth
oBilder.Columns(2).AutoFit
oBilder.Cells(3, 1).Select
Application.ScreenUpdating = True
Exit Sub

fehler:

If Err.Number = 1004 Then sName = sName & "_X": Resume
End If
End Sub



LG

rofu


  

Betrifft: AW: Hyperlink setzen von: Snewi
Geschrieben am: 23.10.2008 08:25:41

macht das Makro das was ich wollte?
Also über einen Button "Bild einlesen" den Link in eine Zelle schreiben oder ein kleines Vorschabild anzeigen was bei Doppelklick geöffnet wird? Oder geht es auch einfacher als oben?

P.S. Es wird ein Fehler ausgegeben "erwartetes Anweisungsende"
Function SHGetPathFromIDList "LIB" "SHELL32.DLL" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare


Gruß


  

Betrifft: AW: Hyperlink setzen von: Snewi
Geschrieben am: 23.10.2008 09:23:13

Ich will ja nur:

Range("C13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"Pfad", TextToDisplay:= _
"Bild"

das ich ein Verzeichnis bekomme um das Bild auszuwählen und dann den Hyperlink in die Zelle zu schreiben!

Gruß

P.S. Wäre auch ein kleines Vorschaubild möglich?


  

Betrifft: AW: Hyperlink setzen von: rofu
Geschrieben am: 23.10.2008 14:26:13

Hallo Snewi,

ich glaube , da sind ein paar Zeilen verloren gegangen.

Probier mal das :


https://www.herber.de/bbs/user/56217.xls

Gruß
rofu


  

Betrifft: AW: Hyperlink setzen von: Snewi
Geschrieben am: 24.10.2008 08:34:10

Hallo,

das sieht schon echt gut aus aber wie kann ich nun ein Bild einzeln einlesen! Ich hab also mehrere Zeilen und nun möchte ich nur in eine Zeile jeweils ein Bild zuordnen nur mit dem Link ohne Vorschaubild das wird sonst zu Groß!

Danke

Gruß


  

Betrifft: AW: Hyperlink setzen von: rofu
Geschrieben am: 26.10.2008 13:03:16

Hallo Snewi,

vielleicht ist es das.

https://www.herber.de/bbs/user/56288.xls

bin gespannt !

gruß

rofu


  

Betrifft: AW: Hyperlink setzen von: Snewi
Geschrieben am: 26.10.2008 20:24:54

Hallo,



sieht schon richtig gemial aus! Geht es das anstatt von Bild der Pfad und der Name des Bildes angezeigt wird?

Und ich fänd es gut das diese Sicherheitsmeldung wegen Hyperlinks nicht erscheint!



Danke im voraus!



Gruß


  

Betrifft: AW: Hyperlink setzen von: rofu
Geschrieben am: 27.10.2008 07:10:49

https://www.herber.de/bbs/user/56310.xls

Hallo,

jetzt wird der Pfad angezeigt, Bild war nur als hinweis gedacht.

Fehlermeldung kommt bei mir keine - welche kommt bei dir?

Gruß

rofu


  

Betrifft: AW: Hyperlink setzen von: Snewi
Geschrieben am: 27.10.2008 08:31:26

Es klappt nun Danke Super :-)


Beiträge aus den Excel-Beispielen zum Thema "Hyperlink setzen"