Hyperlink naar foto's

[Jackson1]

Octafish,

Bedankt voor je code. Ik heb het geheel werkend op 1 puntje na.

Als bij de afwezigheid van een afbeeling de tekst verschijnt blijft deze staan als ik door het formulier heen "blader". Is het mogelijk deze te "resetten" als ik door het formulier heen blader?

 

[Greenery80]

De volgende code zet je neer onder
- Me!Picture.Picture = Me!txtPicture (in cmdBrowse_Click)
- Me!Picture.Picture = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
(in Form_Current)
- Me!Picture.Picture = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
(in Form_Open)

Me.txbFoutmelding = ""

Tevens moet je dit nog aanpassen (klik maar eens op plaatjevenster zonder plaatje):

If Me.txbFoutmelding = "" Then
Application.FollowHyperlink (CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture)
End If

 

[Jackson1]

Greenery80,

Als eerst bedankt voor de reactie.
Helaas werkt de code bij mij niet. Als de tekt er eenmaal staat en ik blader door het formulier dan blijft deze staan en gaat niet meer weg.

Zie voor de code hier onder. Misschien dat ik iets niet goed heb staan?

ption Compare Database
Option Explicit



Private Sub cmdBrowse_Click()

On Error GoTo err_cmdBrowse

Dim sPicture As String

    sPicture = GetOpenFile_CLT(CurrentProject.Path & "\Afbeeldingen", "Select the File")
    If sPicture <> "" Then
        Me![txtPicture] = sPicture
        Me![txtPicture] = Mid(Me![txtPicture], InStrRev(Me![txtPicture], "\") + 1)
        Me![txtPicture] = LCase(Me![txtPicture])
        Me!Picture.Picture = Me!txtPicture
        Me.txbFoutmelding = ""
    End If



exit_cmdBrowse:
    Exit Sub
    
err_cmdBrowse:
    MsgBox Error$
    Resume exit_cmdBrowse
End Sub

Private Sub cmdBrowse_GotFocus()
    cmdBrowse.ForeColor = vbBlue
End Sub

Private Sub cmdBrowse_LostFocus()
    cmdBrowse.ForeColor = vbBlack
End Sub

Private Sub Form_Current()
On Error GoTo err_Form_Current

    If Not Me!txtPicture = "" Or Not IsNull(Me!txtPicture) Then
        Me!Picture.Picture = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
        Me.txbFoutmelding = ""
    Else
        Me!Picture.Picture = ""
    End If
        
exit_Form_Current:
    Exit Sub
    
err_Form_Current:

    Select Case Err.Number
    
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "Kan geen afbeelding vinden"

            
        Case Else
            MsgBox Err.Number
            
    End Select

    Resume exit_Form_Current
End Sub



Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open


    If IsNull(Me!txtPicture) Or Me!txtPicture = "" Then
        ' do nothing
    Else
        Me!Picture.Picture = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
        Me.txbFoutmelding = ""
    End If
            
Exit_Form_Open:
    Exit Sub
    
Err_Form_Open:

MsgBox Err.Description
    

End Sub

Private Sub Picture_Click()

    Application.FollowHyperlink (CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture)

End Sub

Private Sub txtPicture_GotFocus()
    txtPicture.ForeColor = vbBlue
End Sub

Private Sub txtPicture_LostFocus()
    txtPicture.ForeColor = vbBlack
End Sub

Alvast bedankt!

 

[OctaFish]

Zomaar een shot in the dark, maar je kunt dit er eens bijzetten:

Private Sub Form_Current()
[B]Me.Requery[/B]
On Error GoTo err_Form_Current

Daarmee wordt de recordset van het formulier ververst als je een nieuw record opet.

Michel

 

[Jackson1]

Octafish,

Bedankt voor je reactie. Niet geschoten is altijd mis.

Helaas ik kijg een foutmelding. Privat Sub_Current() staat al in de code (zie onder) dus krijg een een foutmelding op:

Private Sub Form_Current()
On Error GoTo err_Form_Current

    If Not Me!txtPicture = "" Or Not IsNull(Me!txtPicture) Then
        Me!Picture.Picture = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
    Else
        Me!Picture.Picture = ""
    End If
        
exit_Form_Current:
    Exit Sub
    
err_Form_Current:

    Select Case Err.Number
    
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "Kan geen afbeelding vinden"

            
        Case Else
            MsgBox Err.Number
            
    End Select

    Resume exit_Form_Current
End Sub

 

[Bakk4318]

OctahFish bedoelt dat je het vet gedrukt gedeelte moet toevoegen in de bestaande code.

 

[Jackson1]

Bakk4318,

Bedankt voor je toelichting. Ik heb het zojuist geprobeerd. Als ik dit doe dan ik niet meer "bladeren".

 

[OctaFish]

Je kan het ook nog proberen met:

Me!Picture.Picture.Requery aan het begin van de Current procedure.

Michel

 

[Greenery80]

Bij mij doet ie het gewoon... met tbxFoutmelding = ""

Ik heb nog een voorbeeldje in db toegevoegd -> label.
En dan simpel label eigenschap Visible op false of true.
Kortom je mag kiezen...

Veel suc6!

 

[Jackson1]

Bedankt!

Greenery,

Bedankt voor het voorbeeld.
Het werk inderdaad perfect!

Bedankt voor jullie hulp. Zonder dit form was het echt niet gelukt!:thumb::thumb: