Knop naar pdf file vba

johnny1980 · 25 aug 2019

Hallo iedereen,

Ik heb een userform met een knop (zoek document) en een tekstbox.
En een knop (ok) om de de inhoud van de tekstbox naar een cel op het werkblad weg te schrijven.

Graag had ik het volgende zien gebeuren wanneer ik op de knop (zoek document) klik:

- Openen (specifieke) map op de pc (opent nu dialog file).
- Aanklikken van een pdf bestand, en ENKEL de NAAM dus zonder de locatie (path) en de extensie (.pdf) van het bestand in de tekstbox weergeven.
- Wanneer op de knop (ok) geklikt wordt moet de inhoud van de tekstbox (naam pdf-bestand) als hyperlink naar het werkblad weggeschreven worden.
Wanneer er in het werkblad op de hyperlink (naam pdf-bestand) geklikt wordt moet het pdf bestand openen.

Alvast bedankt

JanBG · 25 aug 2019

Hallo Johnny,

Helpmij heeft ook een knop, namelijk "bijlage toevoegen"

johnny1980 · 25 aug 2019

Dag Jan,

Excuseer voor het ongemak, ik heb de vraag gepost op de trein , en heb daar geen toegang tot mijn bestanden... De bijlage staat ook gepost bij het onderwerp Â“Excel traagÂ”. In het bestand klikken op cel A1 en de userform gaat open. Onder de textbox Bnx staat de knop ( deze is daar nog wel verborgen omdat het op dat moment nog niet van toepassing was).

Sorry voor het ongemak

Johnny

JanBG · 25 aug 2019

Hoi,

Op de eerste plaats vind ik het persoonlijk handiger om een knop toe te voegen om een userform te openen dan om ergens in het document te klikken.

Verder is de knop die je denk ik bedoelt (zoeken) niet zichtbaar in het Userform:

johnny1980 · 25 aug 2019

Dag Jan,

De knop staat daar idd nog verborgen. Ondertussen is de userform een beetje veranderd van lay-out en indeling, maar het gaat wel degelijk over die knop.
De knop staat nu onder de textbox Bnx.

De knop(pen) ADD+NEW en ADD+CLOSE zijn om de gegevens van de userform weg te schijven.

Het doel van de knop (zoek Bnx) blijft wel hetzelfde

Johnny

JanBG · 25 aug 2019

Hallo Johnny,

Het zou toch echt wat makkelijker worden als je bij de vraag ook het daadwerkelijke bestand voegt waar de vraag over gaat. In het voorbeeldbestand waar je naar verwijst (dat in een andere vraag staat, wat ook al niet handig is), staat de zoekknop helemaal niet onder textbox Bnx en de knoppen ADD + NEW en ADD + CLOSE bestaan niet

johnny1980 · 25 aug 2019

Hallo Jan,

Bij deze het voorbeeld, ik ben er nog aan het sleutelen....

loek010 · 25 aug 2019

Er staat een wachtwoord op je Vba project

JanBG · 25 aug 2019

loek010 zei:
Er staat een wachtwoord op je Vba project

Zo wordt het wel een uitdaging om te helpen Johnny

johnny1980 · 25 aug 2019

Soooooorryyyy,

We werken al reeds met het document op het werk en zou niet graag hebben dat er iets veranderd wordt in de vba weliswaar,....

JanBG · 26 aug 2019

Hoi,

Ik weet niet precies wat je in het document veranderd hebt, maar ik krijg nu een userform, waar ik verder niets mee kan.

Het helpt als je een voorbeeldje plaatst zonder enige vorm van beveiliging dan ook en zonder privacy gevoelige informatie, anders wordt het vrees ik nooit wat

johnny1980 · 27 aug 2019

Hallo Jan,

Ik heb net het bestand (Recap voorbeeld) getest, ik kan er alles mee doen?

johnny

johnny1980 · 27 aug 2019

Bij deze een kleiner voorbeeld met hetzelfde doel.

Nu komt dit in de tekstbox en in het werkblad:
C:\Users\johnn\Desktop\466-20190823326-001.pdf

Na selecteren van het bestand m.b.v. de knop zoek BNX, zou enkel: "466-20190823326-001", als hyperlink naar het document in de tekstbox moeten komen.
466-20190823326-001, zou dan (als hyperlink naar het document) in het werkblad (kolom P), d.m.v. de knop ok moeten weggeschreven worden.

Johnny

Haije · 27 aug 2019

probeer het zo eens:

Code:

Private Sub cmbzoekbnx_Click()
myfilename = Application.GetOpenFilename(, , "Browse for userform1")
[COLOR="#FF0000"]myfilename = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), ".")(0)[/COLOR]
If myfilename = False Then
UserForm1.tbbnx = ""
Else
UserForm1.tbbnx = myfilename
End If
End Sub

loek010 · 27 aug 2019

Zie mijn oplossing voor je vraag met behulp van 1 textbox meer om je hyperlink naar cel te schrijven

johnny1980 · 28 aug 2019

Haijje, Willem,

Bedankt voor jullie reactie, beide oplossingen werken maar,..
De oplossing van Haije werkt in alle gevallen die bij mij van toepassing zijn!

Het stukje code van Willem zou ergen tussen deze moeten komen zie bijllage (Recap voorbeeld, daar staat de knop zoek bnx nog wel "verborgen"):

Code:

Private Sub Cmbtoevoegen_Click()
If tbdatum = "" Then
    Unload Me
    UserFormCal.Show
    Exit Sub
End If
val1 = UserFormCal.TextBox5
val2 = UserFormCal.TextBox6
atrow = val2 - val1 + 1
With Sheets("Recap")
    For X = val1 To val2
        a = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Cells(a, "A").Value = X
    Next
    a = .Range("B" & Rows.Count).End(xlUp).Row + 1
    .Cells(a, "B").Resize(atrow).Value = tbtrein.Value
    .Cells(a, "C").Resize(atrow).Value = tbvertrekuren & ":" & tbvertrekminuten.Value
    .Cells(a, "F").Resize(atrow).Value = cmbvertrek.Value
    .Cells(a, "G").Resize(atrow).Value = cmbaankomst.Value
    .Cells(a, "H").Resize(atrow).Value = tburenaankomst & ":" & tbminutenaankomst.Value
    .Cells(a, "K").Resize(atrow).Value = cmbvia.Value
 If CheckBox4.Value = True Then
    .Cells(a, "N").Resize(atrow).Value = tbsamenstelling & Chr(10) & Chr(10) & tbhg & "HG'S" & " " & tblengte & "M" & " " & tbmassa.Value & "T"
    Else
    .Cells(a, "N").Resize(atrow).Value = tbsamenstelling.Value
End If
If CheckBox5 = True Then
If Cmbsamenstelling.Value >= 0 Then
    .Cells(a, "N").Resize(atrow).Value = Cmbsamenstelling.Value
Else
    .Cells(a, "N").Resize(atrow).Value = tbsamenstelling.Value
End If
End If
    .Cells(a, "P").Resize(atrow).Value = tbbnx.Value


    .Cells(a, "R").Resize(atrow).Value = cmbaanvrager & Chr(10) & cmbip.Value

    '.Range("A1500").End(xlUp).Offset(1, 0).Select
    lr = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A3", "U" & lr).Sort key1:=.Range("A3"), order1:=xlAscending, key2:=.Range("C3"), order2:=xlAscending, Header:=xlNo
End With
    tbtrein.Value = ""
    tbdatum.Value = ""
    tbeinddatum.Value = ""
    tbvertrekuren.Value = ""
    tbvertrekminuten.Value = ""
    tburenaankomst.Value = ""
    tbminutenaankomst.Value = ""
    
    CheckBox6.Value = False
    CheckBox7.Value = False
With Sheets("Lijsten")

    If Application.CountIf(.Columns(8), cmbaanvrager.Value) = 0 Then
      .Cells(Rows.Count, 8).End(xlUp).Offset(1) = cmbaanvrager.Value
      .Range("H1:H1500").Sort key1:=.Range("H1:H1500"), order1:=xlAscending, Header:=xlNo
    End If
  
    If Application.CountIf(.Columns(11), cmbip.Value) = 0 Then
      .Cells(Rows.Count, 11).End(xlUp).Offset(1) = cmbip.Value
      .Range("K1:K1500").Sort key1:=.Range("K1:K1500"), order1:=xlAscending, Header:=xlNo
    End If
    If Application.CountIf(.Columns(2), cmbvertrek.Value) = 0 Then
      .Cells(Rows.Count, 2).End(xlUp).Offset(1) = cmbvertrek.Value
      .Range("B1:B1500").Sort key1:=.Range("B1:B1500"), order1:=xlAscending, Header:=xlNo
    End If
    If Application.CountIf(.Columns(2), cmbaankomst.Value) = 0 Then
      .Cells(Rows.Count, 2).End(xlUp).Offset(1) = cmbaankomst.Value
      .Range("B1:B1500").Sort key1:=.Range("B1:B1500"), order1:=xlAscending, Header:=xlNo
    End If

End With
    Unload UserFormCal
    
End Sub

Ik heb een tekstbox toegevoegd aan de userform en de code van Willen geplaatst onder:

Code:

.Cells(a, "P").Resize(atrow).Value = tbbnx.Value

Het programma opent de hyperlink/document niet.

Johnny

johnny1980 · 28 aug 2019

Nog een klein vraagje,

Wanneer gebruik je dim as?
Welke moet ik dan gebruiken, string, long, object,...… ?

Gebruik je dat om te voorkomen dat het bestand traag gaat werken wat bij mij nu het geval is?
Ik heb deze code in mijn bestand staan en ik denk dat daar iets aan mist/onbreekt?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'On Error GoTo ws_exit

'Tijd aanpassen

'If Target.Column = 3 Then
    
    'lr = Range("A" & Rows.Count).End(xlUp).Row
   ' Range("A3", "U" & lr).Sort key1:=Range("A3"), order1:=xlAscending, key2:=Range("C3"), order2:=xlAscending, Header:=xlNo

'End If

'Opmaak vertrek

For Each c In Range("F3:F" & Range("F300").End(xlUp).Row)
    If c = "SCHAARB.-VORM. BUNDEL C" Then
        Range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 5
        Range("F" & c.Row, "I" & c.Row).Font.Bold = xlMedium
        Range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 5
        Range("A" & c.Row, "D" & c.Row).Font.Bold = xlMedium
        Range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 5
        Range("N" & c.Row, "N" & c.Row).Font.ColorIndex = 5
        Range("R" & c.Row, "R" & c.Row).Font.ColorIndex = 5
        Range("R" & c.Row, "R" & c.Row).Font.Bold = xlMedium
   
  ElseIf c = "SCHAARB.-VORM. BUNDEL R" Then
        Range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 3
        Range("F" & c.Row, "I" & c.Row).Font.Bold = xlMedium
        Range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 3
        Range("A" & c.Row, "D" & c.Row).Font.Bold = xlMedium
        Range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 3
        Range("N" & c.Row, "N" & c.Row).Font.ColorIndex = 3
        Range("R" & c.Row, "R" & c.Row).Font.ColorIndex = 3
        Range("R" & c.Row, "R" & c.Row).Font.Bold = xlMedium
        
  
  ElseIf c = "SCHAARB.-VORM. BUNDEL P" Then
        Range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 10
        Range("F" & c.Row, "I" & c.Row).Font.Bold = xlMedium
        Range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 10
        Range("A" & c.Row, "D" & c.Row).Font.Bold = xlMedium
        Range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 10
        Range("N" & c.Row, "N" & c.Row).Font.ColorIndex = 10
        Range("R" & c.Row, "R" & c.Row).Font.ColorIndex = 10
        Range("R" & c.Row, "R" & c.Row).Font.Bold = xlMedium
    
   ElseIf c = "SCHAARB.-VORM. BUNDEL L" Then
        Range("F" & c.Row, "G" & c.Row).Font.ColorIndex = 3
        Range("F" & c.Row, "I" & c.Row).Font.Bold = xlMedium
        Range("A" & c.Row, "D" & c.Row).Font.ColorIndex = 3
        Range("A" & c.Row, "D" & c.Row).Font.Bold = xlMedium
        Range("H" & c.Row, "I" & c.Row).Font.ColorIndex = 3
        Range("N" & c.Row, "N" & c.Row).Font.ColorIndex = 3
        Range("R" & c.Row, "R" & c.Row).Font.ColorIndex = 3
        Range("R" & c.Row, "R" & c.Row).Font.Bold = xlMedium
    
    End If
Next

'Opmaak aankomst
For Each o In Range("G3:G" & Range("G300").End(xlUp).Row)
    If o = "SCHAARB.-VORM. BUNDEL C" Then
        Range("G" & o.Row).Font.ColorIndex = 1
        
    ElseIf o = "SCHAARB.-VORM. BUNDEL R" Then
        Range("G" & o.Row).Font.ColorIndex = 3
        
    ElseIf o = "SCHAARB.-VORM. BUNDEL P" Then
        Range("G" & o.Row).Font.ColorIndex = 10
        
    ElseIf o = "SCHAARB.-VORM. BUNDEL L" Then
        Range("G" & o.Row).Font.ColorIndex = 3
           
    End If
Next

'Kleur Via
For Each v In Range("K3:K" & Range("K300").End(xlUp).Row)
    If v = "FBN" Then
        Range("K" & v.Row).Interior.ColorIndex = 43
    ElseIf v = "FVV" Then
        Range("K" & v.Row).Interior.ColorIndex = 45
    ElseIf v = "NVT" Then
        Range("K" & v.Row).Interior.ColorIndex = xlNone
    
    End If
Next


'Randen

If Target.Count = 1 Then
Select Case Target.Column

    Case 1
      If Target.Value >= "0" Then
         Target.Resize(, 19).Borders.Weight = xlThin
         Target.Offset(, 12).Resize(, 3).Borders.Weight = 3
      End If
    
'Opmaak vertrek
    'Case 6
     ' If Target.Value = "SCHAARB.-VORM. BUNDEL C" Then Y = 5
      'If Target.Value = "SCHAARB.-VORM. BUNDEL R" Then Y = 3
      'If Target.Value = "SCHAARB.-VORM. BUNDEL P" Then Y = 10
      'If Target.Value = "SCHAARB.-VORM. BUNDEL L" Then Y = 3
        
       ' Target.Offset(, -5).Resize(, 4).Font.ColorIndex = Y
       ' Target.Offset(, -5).Resize(, 4).Font.Bold = xlMedium
       ' Target.Resize(, 4).Font.ColorIndex = Y
       ' Target.Resize(, 4).Font.Bold = xlMedium
       ' Target.Offset(, 8).Font.ColorIndex = Y
       ' Target.Offset(, 12).Font.ColorIndex = Y
       ' Target.Offset(, 12).Font.Bold = xlMedium
   'Opmaak aankomst
  
    'Case 7
     ' If Target.Value = "SCHAARB.-VORM. BUNDEL C" Then Y = 1
     ' If Target.Value = "SCHAARB.-VORM. BUNDEL R" Then Y = 3
    ' If Target.Value = "SCHAARB.-VORM. BUNDEL P" Then Y = 10
    '  If Target.Value = "SCHAARB.-VORM. BUNDEL L" Then Y = 3
     '  Target.Font.ColorIndex = Y
        
'Opmaak via

    Case 11
      Target.Interior.ColorIndex = IIf(Target.Value = "FBN", 43, IIf(Target.Value = "FVV", 45, xlNone))
    
'Spoor
    Case 12
      Target.Interior.ColorIndex = IIf(Target.Value >= "0", 36, xlNone)

'Opmaak rij
    Case 18
       If InStr(Target.Value, "BOOK IN") Then Target.Offset(, -17).Resize(, 10).Interior.ColorIndex = 36
       If InStr(Target.Value, "BOOK IN") Then Target.Offset(, -5).Resize(, 6).Interior.ColorIndex = 36
       If InStr(Target.Value, "LINEAS") Then Target.Offset(, -17).Resize(, 10).Interior.ColorIndex = 34
       If InStr(Target.Value, "LINEAS") Then Target.Offset(, -5).Resize(, 6).Interior.ColorIndex = 34

'Opmaak vertraging vetrek
    Case 4
 If Target.Value > Target.Offset(, -1) Then Target.Offset(, 1).Resize.Font.ColorIndex = 3
 'If Target.Value > Target.Offset(, -1) Then
 'UserForm7.Show

 If Target.Value <= Target.Offset(, -1) Then Target.Offset(, 1).Resize.Font.ColorIndex = 5
 
'Opmaak vertraging aankomst
 Case 9
 If Target.Value > Target.Offset(, -1) Then Target.Offset(, 1).Resize.Font.ColorIndex = 3
 If Target.Value <= Target.Offset(, -1) Then Target.Offset(, 1).Resize.Font.ColorIndex = 5
   End Select
End If
'ws_exit:
'Application.EnableEvents = True
End Sub

Johnny

loek010 · 28 aug 2019

Beste Johnny,
de code van Haijje haalt alleen maar het volledige pad uit de string om alleen maar je bestandsnaam zichtbaar te maken
in de textbox ,maar maakt geen hyperlink naar je bestand omdat het pad naar je bestand weg is

Vervang dit stukje code in je userform1

Code:

.Cells(a, "P").Resize(atrow).Value = tbbnx.Value

door dit stukje code

Code:

Application.ActiveSheet.Hyperlinks.Add _
    Anchor:=Application.ActiveSheet.Cells(a, "P").Resize(atrow), _
    Address:=FilePath.Text, _
    SubAddress:="", _
    ScreenTip:="Pdf bestand", _
    TextToDisplay:=tbbnx.Text

Plaats deze code onder de knop Zoek BNX in je Userform

Code:

Private Sub Cmbzoek_Click()
    myfilename = Application.GetOpenFilename(, , "Browse for userform1")
    If myfilename = False Then
        UserForm1.tbbnx = ""
    Else
        UserForm1.tbbnx = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), ".")(0)
        UserForm1.FilePath = myfilename
    End If
End Sub

en als laatste maak een nieuwe TextBox aan in je userform1 en geef die de naam FilePath en zet deze desgewenst op Visible = False
De Textbox FilePath is je pad naar het bestand om die weg te schrijven als hyperlink naar je bestand

johnny1980 · 29 aug 2019

Haije zei:

probeer het zo eens:

Code:

Private Sub cmbzoekbnx_Click()
myfilename = Application.GetOpenFilename(, , "Browse for userform1")
[COLOR="#FF0000"]myfilename = Split(Split(myfilename, "\")(UBound(Split(myfilename, "\"))), ".")(0)[/COLOR]
If myfilename = False Then
UserForm1.tbbnx = ""
Else
UserForm1.tbbnx = myfilename
End If
End Sub

Hajie,

Er blijft bij mij nog BNX-466,..... staan,
hoe krijg in de BNX- ook nog weg?

Johnny

Haije · 29 aug 2019

hoe heet je bestand dan voluit?

Knop naar pdf file vba

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Bijlagen

Gebruiker

Verenigingslid

Gebruiker

Bijlagen

Verenigingslid

Gebruiker

Gebruiker

Bijlagen

Terugkerende gebruiker

Gebruiker

Bijlagen

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Terugkerende gebruiker

Wij waarderen jouw privacy