Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hyperlink mit Abfrage hinzufügen

Hyperlink mit Abfrage hinzufügen
19.06.2008 09:37:01
Stefan
Hallo liebe Excel-Helfer,
ich erbitte Eure Unterstützung bei folger Aufgabe. Ich möchte eine kleine Röntgenbildverwaltung anlegen. Erste Spalte Name, 2. Spalte Geb.Dat. 3. Spalte Aktenzeichen, 4. - 8. Hyperlinks auf die Röntgenbilder.
Nun möchte ich, dass bei Doppelklick in den Spalten 4 - 8 das Fenster erscheint, wie bei Hyperlink, Datei, und dann Dateityp - alle anzeigen. So das hier die entsprechende Datei ausgewählt werden kann und dieser dann in die aktuelle Zelle übernommen wird. Damit hier nicht der ganze Hyperlinkpfad angezeigt wird, wandle ich den angezeigten Pfad um in eine 5, formatiert in ein Windings2 Kästchen.
Was ich eben nicht hinbekomme ist dieser Hyperlin-Kasten.
Folgenden Code habe ich mir bis jetzt zusammengestrickt:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim aktzeile, aktspalte
If ActiveCell.Hyperlinks.Count > 0 Then 'Abfrage, ob Hyperlink vorhanden
Exit Sub
Else:
Hier müsste die Abrage rein
Target.Cells = "5"
With Selection.Font
.Name = "Wingdings 2"
.Size = 16
.ColorIndex = 10
.Bold = True
End With
End If
Cancel = True
End Sub


Vielen Dank für Eure Hilfe.
Gruß Stefan

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink mit Abfrage hinzufügen
19.06.2008 13:24:00
fcs
Hallo Stefan,
man kann sich das Leben natürlich durch solche "Formatierungs-Spielereien" selber unnötig schwer machen.
nachfolgend mein Lösungsvorschlag.
Gruß
Franz

'Erstellt für Excel 2003
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim aktzeile As Long, aktspalte As Long
Dim varAuswahl
If Target.Column >= 4 And Target.Column  0 Then 'Abfrage, ob Hyperlink vorhanden
Exit Sub
Else
'Dialog - Hyperlink einfügen anzeigen
varAuswahl = Application.Dialogs(xlDialogInsertHyperlink).Show
If varAuswahl  False Then
'Verzeichnis vom Dateinamen abtrennen.
Target = "5...\" & Right(Target.Value, Len(Target.Value) - InStrRev(Target.Value, "\"))
'1. Zeichen anders formatieren
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings 2"
.Size = 16
.ColorIndex = 10
.Bold = True
End With
End If
End If
Cancel=True
End If
End Sub


Anzeige
AW: Hyperlink mit Abfrage hinzufügen
19.06.2008 15:32:06
Stefan
Hallo Franz,
sowas habe ich gesucht. Vielen Dank.
Besteht zusätzlich zum .show-Befefehl die Möglichkeit eine Vorauswahl
zum Ordner zu treffen und das alle Dateien angezeigt werden sollen und
nicht nur Office-Dateien ?
Besten Dank für Deine Hilfe.
Gruß
Stefan

AW: Hyperlink mit Abfrage hinzufügen
19.06.2008 16:31:28
fcs
Hallo Stefan,
bei mir werden alle Dateitypen in der Auswahl angeboten. Gemäß VBA-Hilfe hat der Hyperlink-Einfügen-Dialog keine Parameter.
Ich bin deshalb den "Umweg" über einen Dateiauswahl-Dialog gegangen, der entsprechende Möglichkeiten bietet.
Gruß
Franz

'Erstellt für Excel 2003
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim aktzeile As Long, aktspalte As Long
Dim varAuswahl, strPfadaktuell As String
Const strPfad As String = "C:\Lokale daten\Test" 'Standardverzeichnis für Auswahl
Const strFilter As String = "Alle(*.*),*.*"
If Target.Column >= 4 And Target.Column  0 Then 'Abfrage, ob Hyperlink vorhanden
Exit Sub
Else
strPfadaktuell = VBA.CurDir 'Aktuellen Pfad merken
VBA.ChDir strPfad
varAuswahl = Application.GetOpenFilename(Filefilter:=strFilter, _
Title:="Röntgenbild-Auswahl", _
MultiSelect:=False)
If varAuswahl  False Then
Me.Hyperlinks.Add Anchor:=Target, Address:=varAuswahl, _
ScreenTip:="Röntgenbild: " & varAuswahl, _
TextToDisplay:="Röntgenbild: " & varAuswahl
'Verzeichnis vom Dateinamen abtrennen.
Target = "5...\" & Right(Target.Value, Len(Target.Value) - InStrRev(Target.Value, "\"))
With Target.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings 2"
.Size = 16
.ColorIndex = 10
.Bold = True
End With
End If
VBA.ChDir strPfadaktuell 'Pfad zurücksetzen
End If
Cancel = True
End If
End Sub


Anzeige
AW: Hyperlink mit Abfrage hinzufügen
20.06.2008 07:32:00
Stefan
Hallo Franz,
das wird ja immer besser. Vielen Dank für Deine Mühe. Über diesen Umweg klappt das perfekt.
Vielen Dank und schönes Wochenende.
Gruß
Stefan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige