Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > Hyperlink VBA
Normale Version: Hyperlink VBA
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.

jnbart

26.07.2021, 14:13
Hi,

ich habe folgendes Problem:

und zwar möchte ich, dass wenn ich auf P1 klicke ein Bild suchen kann (funktioniert auch).
Der pfad zu diesem Bild wird mir dann auf eine Textbox ausgegeben (funktioniert auch).
Nun soll mit drücken auf Apply dieser Pfad als Hyperlink in die nächste freie Zelle geschrieben werden und das bekomme ich einfach nicht hin.
Excel schreibt nur den Pfad in die Zelle - ich weiß allerdings nicht wie ich diesen Pfad als Hyperlink hinbekomme.

Hier der Code:

Code:
Private Sub cmbPicture1_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture1 = strPfad
Else
End If

End Sub
Private Sub cmbPicture2_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture2 = strPfad
Else
End If

End Sub
Private Sub cmbPicture3_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture3 = strPfad
Else
End If

End Sub

Private Sub cmdCancel_Click()
    'Schließt Formular'
   
    Unload Me
End Sub

Private Sub cmdApply_Click()
    'Schließt Formular und speichert Daten'
   
    Dim inErsteLeereZeile As Long
   
    intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
   
    ActiveSheet.Cells(intErsteLeereZeile, 1).Value = Me.txtNumber.Value
    ActiveSheet.Cells(intErsteLeereZeile, 2).Value = Me.txtDate.Value
    ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.cobTicker.Value
    ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.cobStrategy.Value
    ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.cobDirection.Value
    ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.cobLot.Value
    ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.cobOrder.Value
    ActiveSheet.Cells(intErsteLeereZeile, 12).Value = Me.txtTimeOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.txtPriceOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 14).Value = Me.txtStoploss.Value
    ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.txtTimeClose.Value
    ActiveSheet.Cells(intErsteLeereZeile, 16).Value = Me.txtPriceClose.Value
    ActiveSheet.Cells(intErsteLeereZeile, 18).Value = Me.txtPicture1.Value
    ActiveSheet.Cells(intErsteLeereZeile, 19).Value = Me.txtPicture2.Value
    ActiveSheet.Cells(intErsteLeereZeile, 20).Value = Me.txtPicture3.Value
    ActiveSheet.Cells(intErsteLeereZeile, 30).Value = Me.txtDescription.Value
   
    Unload Me
End Sub


Private Sub UserForm_Initialize()
'Werte bei Aufruf des Formulars eintragen'

With Me
    .txtDate.Value = Date
    .txtTimeClose.Value = Time
    .txtTimeOpen.Value = Time
End With

With frmdashboard.cobTicker
    .AddItem "FGBL"
    .AddItem "FESX"
    .AddItem "ES"
    .AddItem "SI"
End With

With frmdashboard.cobStrategy
    .AddItem "VOLUME"
    .AddItem "TREND"
    .AddItem "HOLE"
    .AddItem "ORDERBOOK"
End With

With frmdashboard.cobDirection
    .AddItem "SELL"
    .AddItem "BUY"
End With

With frmdashboard.cobOrder
    .AddItem "LIMIT"
    .AddItem "MARKET"
    .AddItem "STOP"
End With

With frmdashboard.cobLot
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .AddItem "4"
    .AddItem "5"
    .AddItem "10"
End With

End Sub

Vielleicht kann mir ja jemand weiterhelfen.

Besten dank und Grüße

Case

26.07.2021, 16:58
Hallo, 19 

z. B. so: 21 

Code:
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 23), Address:=txtPicture1.Text, TextToDisplay:=txtPicture1.Text

Wobei ich das "ActiveSheet" noch umarbeiten würde. Nimm da lieber einen "With-Rahmen". Achte dann auf die Punkte. Das "Me" kannst du auch weglassen. Es verschiebt aber nicht die Erdachse, wenn du es drin lässt.

Code:
With Tabelle4
    intErsteLeereZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(intErsteLeereZeile, 1).Value = txtNumber.Value
    '
    '
End With

jnbart

27.07.2021, 06:34
Hi Case,

super hat funktioniert - vielen lieben Dank

jnbart

27.07.2021, 07:18
Gibt es noch eine Möglichkeit, wenn kein Bild geladen wird, dass er mir keinen Laufzeitfehler auswirft?

Case

27.07.2021, 07:27
Hallo, 19 

du könntest z. B. prüfen, ob in der TextBox was steht: 21 

Code:
If Trim(txtPicture1.Text) <> "" Then
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 23), Address:=txtPicture1.Text, TextToDisplay:=txtPicture1.Text
End If

jnbart

27.07.2021, 09:16
Perfekt,

super vielen Dank 19 
und mal wieder was dazugelernt

jnbart

27.07.2021, 10:08
So letztes Probelm 19 

wenn man die Eingabemaske öffnet soll beim Textfeld .txtNumber eine fortlaufende Zahl erscheinen.
Sprich wenn ich schon 5 Einträge in meiner Tabelle habe und ich die Eingabemaske starte, soll schon eine 6 darstehen.
Code:
Private Sub cmbPicture1_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture1 = strPfad
Else
End If

End Sub
Private Sub cmbPicture2_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture2 = strPfad
Else
End If

End Sub
Private Sub cmbPicture3_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture3 = strPfad
Else
End If

End Sub


Private Sub cmdCancel_Click()
    'Schließt Formular'
   
    Unload Me
End Sub

Private Sub cmdApply_Click()
    'Schließt Formular und speichert Daten'
   
    Dim inErsteLeereZeile As Long
   
    intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
   
    ActiveSheet.Cells(intErsteLeereZeile, 1).Value = Me.txtNumber.Value
    ActiveSheet.Cells(intErsteLeereZeile, 2).Value = Me.txtDate.Value
    ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.cobTicker.Value
    ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.cobStrategy.Value
    ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.cobDirection.Value
    ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.cobLot.Value
    ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.cobOrder.Value
    ActiveSheet.Cells(intErsteLeereZeile, 12).Value = Me.txtTimeOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.txtPriceOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 14).Value = Me.txtStoploss.Value
    ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.txtTimeClose.Value
    ActiveSheet.Cells(intErsteLeereZeile, 16).Value = Me.txtPriceClose.Value
        If Trim(txtPicture1.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 18), Address:=txtPicture1.Text, TextToDisplay:=txtPicture1.Text
        End If
        If Trim(txtPicture2.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 19), Address:=txtPicture2.Text, TextToDisplay:=txtPicture2.Text
        End If
        If Trim(txtPicture3.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 20), Address:=txtPicture3.Text, TextToDisplay:=txtPicture3.Text
        End If
    ActiveSheet.Cells(intErsteLeereZeile, 30).Value = Me.txtDescription.Value
   
    Unload Me
End Sub



Private Sub UserForm_Initialize()
'Werte bei Aufruf des Formulars eintragen'

With Me
    .txtDate.Value = Date
    .txtTimeClose.Value = Time
    .txtTimeOpen.Value = Time
End With

With frmdashboard.cobTicker
    .AddItem "FGBL"
    .AddItem "FESX"
    .AddItem "ES"
    .AddItem "SI"
End With

With frmdashboard.cobStrategy
    .AddItem "VOLUME"
    .AddItem "TREND"
    .AddItem "HOLE"
    .AddItem "ORDERBOOK"
End With

With frmdashboard.cobDirection
    .AddItem "SELL"
    .AddItem "BUY"
End With

With frmdashboard.cobOrder
    .AddItem "LIMIT"
    .AddItem "MARKET"
    .AddItem "STOP"
End With

With frmdashboard.cobLot
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .AddItem "4"
    .AddItem "5"
    .AddItem "10"
End With

End Sub

EA1950

27.07.2021, 10:35
Hallo,

habe dir in der SUB UserForm_Initialize() die nötigen 3 Zeilen hinzugefügt.
Ferner habe ich dir in der SUB cmdApply_Click() das DIM  korrigiert (falscher Variablenname!)
Code:
Private Sub cmbPicture1_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture1 = strPfad
Else
End If

End Sub
Private Sub cmbPicture2_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture2 = strPfad
Else
End If

End Sub
Private Sub cmbPicture3_Click()

Dim strPfad As Variant
strPfad = Application.GetOpenFilename
If strPfad <> False Then
  txtPicture3 = strPfad
Else
End If

End Sub


Private Sub cmdCancel_Click()
    'Schließt Formular'
  
    Unload Me
End Sub

Private Sub cmdApply_Click()
    'Schließt Formular und speichert Daten'
  
    Dim intErsteLeereZeile As Long
  
    intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
  
    ActiveSheet.Cells(intErsteLeereZeile, 1).Value = Me.txtNumber.Value
    ActiveSheet.Cells(intErsteLeereZeile, 2).Value = Me.txtDate.Value
    ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.cobTicker.Value
    ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.cobStrategy.Value
    ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.cobDirection.Value
    ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.cobLot.Value
    ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.cobOrder.Value
    ActiveSheet.Cells(intErsteLeereZeile, 12).Value = Me.txtTimeOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.txtPriceOpen.Value
    ActiveSheet.Cells(intErsteLeereZeile, 14).Value = Me.txtStoploss.Value
    ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.txtTimeClose.Value
    ActiveSheet.Cells(intErsteLeereZeile, 16).Value = Me.txtPriceClose.Value
        If Trim(txtPicture1.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 18), Address:=txtPicture1.Text, TextToDisplay:=txtPicture1.Text
        End If
        If Trim(txtPicture2.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 19), Address:=txtPicture2.Text, TextToDisplay:=txtPicture2.Text
        End If
        If Trim(txtPicture3.Text) <> "" Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(intErsteLeereZeile, 20), Address:=txtPicture3.Text, TextToDisplay:=txtPicture3.Text
        End If
    ActiveSheet.Cells(intErsteLeereZeile, 30).Value = Me.txtDescription.Value
  
    Unload Me
End Sub



Private Sub UserForm_Initialize()
'Werte bei Aufruf des Formulars eintragen'
    Dim intErsteLeereZeile As Long
  
    intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1


With Me
    .txtDate.Value = Date
    .txtTimeClose.Value = Time
    .txtTimeOpen.Value = Time
    .txtNumber.Value = intErsteLeereZeile
End With

With frmdashboard.cobTicker
    .AddItem "FGBL"
    .AddItem "FESX"
    .AddItem "ES"
    .AddItem "SI"
End With

With frmdashboard.cobStrategy
    .AddItem "VOLUME"
    .AddItem "TREND"
    .AddItem "HOLE"
    .AddItem "ORDERBOOK"
End With

With frmdashboard.cobDirection
    .AddItem "SELL"
    .AddItem "BUY"
End With

With frmdashboard.cobOrder
    .AddItem "LIMIT"
    .AddItem "MARKET"
    .AddItem "STOP"
End With

With frmdashboard.cobLot
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
    .AddItem "4"
    .AddItem "5"
    .AddItem "10"
End With

End Sub
Clever-Excel-Forum > Office-Anwendungen > Excel > Hyperlink VBA