Afbeeldingen oproepen in een rapport

Status
Niet open voor verdere reacties.

Butskever

Gebruiker
Lid geworden
13 mrt 2014
Berichten
28
Goedemiddag
Ik heb een databaseformulier in Access waarin ik foto's kan oproepen die elders op een (netwerk)directory staan. Het voordeel hiervan is dat de foto's geen geheugen in beslag nemen, aangezien ze niet in de database zelf staan.
Nu wil ik dezelfde foto's ook oproepen in een rapport om vervolgens het rapport met de foto's te kunnen printen. Echter ik krijg dit niet voor elkaar. Bijgevoegd is de code die de foto's oproept in het formulier.

Mijn vraag is hoe de code aangepast moet worden om deze ook werkend te krijgen in het rapport?

Code:
Option Compare Database
Option Explicit

Private Sub Form_Current()
On Error GoTo err_Form_Current

    If Not Me!txtPicture = "" Or Not IsNull(Me!txtPicture) Then
        Me!Picture.Picture = GetPathPart & Me!txtPicture
    Else
        Me!Picture.Picture = ""
    End If
        
    If Not Me!txtPicture1 = "" Or Not IsNull(Me!txtPicture1) Then
        Me!Picture1.Picture = GetPathPart & Me!txtPicture1
    Else
        Me!Picture1.Picture = ""
    End If
    
    If Not Me!txtPicture2 = "" Or Not IsNull(Me!txtPicture2) Then
        Me!Picture2.Picture = GetPathPart & Me!txtPicture2
    Else
        Me!Picture2.Picture = ""
    End If
        
exit_Form_Current:
    Exit Sub
    
err_Form_Current:
    MsgBox Err.Description
    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 = GetPathPart & Me!txtPicture
    End If
            
    If IsNull(Me!txtPicture1) Or Me!txtPicture1 = "" Then
        ' do nothing
    Else
        Me!Picture1.Picture = GetPathPart & Me!txtPicture1
    End If
    
    If IsNull(Me!txtPicture2) Or Me!txtPicture2 = "" Then
        ' do nothing
    Else
        Me!Picture2.Picture = GetPathPart & Me!txtPicture2
    End If
    
Exit_Form_Open:
    Exit Sub
    
err_Form_Open:
    MsgBox Err.Description
    Resume Exit_Form_Open
        
End Sub

Private Function GetPathPart() As String
    ' Comments  : Returns the path part of a string
    ' Parameters: strPath - string to parse
    ' Returns   : path part
    '
    Dim db As DAO.Database
    Dim strPath As String
    Dim intCounter As Integer
    
    Set db = CurrentDb
    strPath = db.Name
    db.Close
    Set db = Nothing
        
    For intCounter = Len(strPath) To 1 Step -1
        If Mid$(strPath, intCounter, 1) = "\" Then
            Exit For
        End If
    Next intCounter
    
    GetPathPart = Left$(strPath, intCounter) & "\Afbeeldingen\"

End Function
 
Laatst bewerkt:
Ik snap op je formulier een aantal zaken niet. Daarmee bedoel ik natuurlijk: ik snáp ze wel, maar ik begrijp niet waarom je het zo doet :) Om te beginnen: je gebruikt dezelfde code bij Form_Current en Form_Open. Die open code kan gewoon weg, want dat is dubbel op. Current wordt namelijk altijd uitgevoerd, en Open maar één keer. Niet nodig dus.

Daarnaast maak je geen gebruik van de IntelliSense, en dat dwingt je dus tot nodeloos veel typen. Tenzij je daar van houdt (wie ben ik om dat af te keuren?) is het niet de handigste werkwijze, ook al omdat je met IntelliSense fouten voorkomt. Dus gebruik dit:
Code:
    If Not Me.txtPicture.Value = "" Or Not IsNull(Me.txtPicture.Value) Then
        Me.Picture.Picture = GetPathPart & Me.txtPicture.Value
i.p.v. dit:
Code:
    If Not Me!txtPicture.Value = "" Or Not IsNull(Me!txtPicture.Value) Then
        Me!Picture.Picture = GetPathPart & Me!txtPicture.Value

Verder snap ik niet dat je a) een functie nodig hebt voor het pad en b) dat-ie het bij jou wel doet: bij mij krijg ik dit, en daar zit echt een fout in:
PHP:
C:\Users\@@@@@@\OneDrive\Documenten\_Microsoft Office\_Programmeren\Afbeeldingen\foto in rapport\Back Ups\\Afbeeldingen\
Wat veel makkelijker is om het pad op te roepen, is deze code (één regeltje, dus ook nooit een aparte functie nodig)
Code:
    strPath = CurrentProject.Path & "\Afbeeldingen\"


En de vierde wenkbrauw werd opgetrokken toen ik zag dat je meerdere keren dezelfde code nodig had om meerdere plaatjes te vullen. Met de juiste benamingen voor je objecten, kun je dat met een loop in één keer als code wegzetten. Namelijk zo:
Code:
    strPath = CurrentProject.Path & "\Afbeeldingen\"    For i = 1 To 3
        If Not Me("txtPicture" & i).Value = "" Then
            Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
        Else
            Me("Picture" & i).Picture = ""
        End If
    Next i
    Exit Sub

Ook erg handig als je later meer foto's nodig hebt. Gewoon extra tekstvak erbij met een hoger volgnummer, en een PictureFrame met hetzelfde hogere nummer. In de code pas je dan alleen de hoogste waarde van de loop aan.

Nu naar je rapport. Dat werkt min of meer op dezelfde manier, maar op een andere plek in je rapport. Probeer dit eens:
Code:
Private Sub Details_Format(Cancel As Integer, FormatCount As Integer)
Dim strPath As String
    
    strPath = CurrentProject.Path & "\Afbeeldingen\"
    For i = 1 To 3
        If Not Me("txtPicture" & i).Value = "" Then
            Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
        Else
            Me("Picture" & i).Picture = ""
        End If
    Next i
    Exit Sub
    
    On Error GoTo NoFoto


NoFoto:
    Me.Picture = ""


End Sub
 
Thx Accessguru voor het uitvoerige antwoord. Ik ga het aanpassen en toepassen.
Ik laat dit weekend even weten of het gelukt is.
 
Hallo AccessGuru
Ik heb nu de volgende code in mijn formulier staan:
Code:
Option Compare Database
Option Explicit

Private Sub Form_Current()
On Error GoTo err_Form_Current

Dim strPath As String
    strPath = CurrentProject.Path & "\Afbeeldingen\"
    For i = 1 To 3
        If Not Me("txtPicture" & i).Value = "" Then
            Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
        Else
            Me("Picture" & i).Picture = ""
        End If
    Next i
    Exit Sub
    
    On Error GoTo NoFoto


NoFoto:
    Me.Picture = ""


exit_Form_Current:
    Exit Sub
    
err_Form_Current:
    MsgBox Err.Description
    Resume exit_Form_Current

End Sub

De naam komt juist onder de afbeelding te staan, maar de afbeelding zelf wordt niet weergegeven. Enig idee wat er niet correct is?

Screenshot:
Knipsel.JPG

De afbeeldingboxen zijn genaamd:
Picture1
Picture2
Picture3
 
Laatst bewerkt:
In de code voor het rapport zat een klein foutje, een letter teveel. Kan gebeuren als je het uit het hoofd doet :). Deze code werkt:
Code:
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)Dim i As Integer, strPath As String


    On Error GoTo NoFoto
    strPath = CurrentProject.Path & "\Afbeeldingen\"
    For i = 1 To 3
        If Not Me("txtPicture" & i).Value = "" Then
            Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
        Else
            Me("Picture" & i).Picture = ""
        End If
    Next i
    Exit Sub


NoFoto:
    Me.Picture = ""
End Sub

En op het formulier:
Code:
Private Sub Form_Current()Dim strPath As String, i As Integer
    
    On Error GoTo NoFoto
    strPath = CurrentProject.Path & "\Afbeeldingen\"
    For i = 1 To 3
        If Not Me("txtPicture" & i).Value = "" Then
            Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
        Else
            Me("Picture" & i).Picture = ""
        End If
    Next i
    Exit Sub


NoFoto:
    Me.Picture = ""
End Sub



Getest in jouw db, en het werkt. Graag de volgende keer zelf wat voorbeeldjes inkloppen. Wij helpen graag met oplossingen, maar ik ben geen​ tikgeit :D.
 
Dank je wel AccessGuru. Op het formulier werkt het inderdaad bij mij ook. Maar het rapport laat de afbeeldingen nog niet zien. Had jij het rapport ook getest?

PS. Ik ben echter echt een leek op het gebied van VB code. Bij mij is het dus met name kopie-paste. De logica snap ik wel, maar het zelf bedenken is geen optie voor mij (en foutjes herken ik ook niet zo snel). Maar ik probeer het wel!
Neem van mij aan dat ik hier heel wat uren/ dagen in heb zitten met testen en zoeken op internet naar tips.
 
Laatst bewerkt:
Ik zie dat de foto's wel worden weergegeven in het rapport, maar via een omweg.
Als ik op een Id klik dan opent het formulier. Als ik daarin klik op Afdrukken, dan verschijnt een formulier zonder foto's. Ik moet dan het printscherm dat op-popt annuleren en dan drukken op "Afdrukvoorbeeld" dan openen de foto's wel op het rapport wat afgedrukt gaat worden.
Heb je hiervoor toevallig nog een oplossing dat direct de foto's zichtbaar worden in het rapport?
 
Ik snap je probleem niet helemaal; bij mij werkt het volledig zelfstandig, zowel op formulier als op rapport.
Als ik op een Id klik dan opent het formulier. Als ik daarin klik op Afdrukken, dan verschijnt een formulier zonder foto's.
En ik ben hier al weg :).
 
Hier mijn werkende versie.
 

Bijlagen

  • database.zip
    1,7 MB · Weergaven: 28
Hoi AccessGuru, de code heeft me een stuk verder geholpen, ik zit alleen met 1 klein probleempje: wat als de afbeelding niet aanwezig is?

Bij mij geeft dit een foutmelding 2220 maar op de ea manier werkt het niet zoals het hoort, wat zie ik over het hoofd? de afbeelding "geen foto.jpg staat in de map waar ook de andere afbeeldingen staan maar toch komt deze niet tevoorschijn :confused:



Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Err_foto_Click

Dim i As Integer

strPath = CurrentProject.Path & "\Afbeeldingen"
For i = 1 To 1
If Not Me("txtPicture" & i).Value = "" Then
Debug.Print strPath & Me("txtPicture" & i)
Me("Picture" & i).Picture = strPath & Me("txtPicture" & i)
Else
Me("Picture" & i).Picture = ""
End If
Next i
Exit Sub

Exit_foto_Click:
Exit Sub

Err_foto_Click:
If Err.Number = 2220 Then
Me.Picture = "geenfoto.jpg"

Else
MsgBox Err.Description & Err.Number
End If
Resume Exit_foto_Click
End Sub
 
@Daneron: Een paar opmerkingen:
1. Als een voorbeeld bij jou niet werkt, maak dan een eigen vraag aan met daarin jouw probleem. TS heeft een werkende oplossing, en zit dus niet te wachten op berichten van jouw problemen :).
2. Als je code toevoegt aan een bericht, zet dat dan tussen CODE tags.

Voor deze ene keer een antwoord (nogmaals: maak een eigen vraag aan) met de problemen die ik zie in jouw code.

Om te beginnen: je hebt zo te zien maar één afbeelding. Dan hoef je daar (mag wel trouwens) niet met een lus doorheen. In je Error procedure gebruik je geen pad. Dat betekent dat Access je afbeelding "geenfoto.jpg" niet kan vinden. (veel belangrijker) Je pad eindigt niet met een backslash, dus de namen van je foto's worden sowieso niet gevonden. Dus je zou deze variant moeten gebruiken:
Code:
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
On Error GoTo Err_foto_Click


    strPath = CurrentProject.Path & "\Afbeeldingen\"
    If Not Me.txtPicture1.Value = "" Then
        Debug.Print strPath & Me.txtPicture1.Value
        Me.Picture1.Picture = strPath & Me.txtPicture1.Value
    Else
        Me.Picture1.Picture = ""
    End If
    Exit Sub
    
Err_foto_Click:
    If Err.Number = 2220 Then
        Me.txtPicture1.Value = strPath & "geenfoto.jpg"
        Me.Picture1.Picture = strPath & "geenfoto.jpg"
    Else
        MsgBox Err.Description & Err.Number
    End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan