Afbeelding oproepen in rapport

[ErikKEN]

Beste heren,

Ik heb een uitdaging omtrend het oproepen van afbeeldingen in rapporten.

De afbeeldingen worden in een formulier weggeschreven naar een tabel m.b.v. de volgende code

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) & "\Pictures\Cilinders\"

End Function

In het formulier werkt dit perfect. Zodra ik in het veld de naam van de afbeelding plaats en vervolgens op F5 druk, verschijnt de juiste afbeelding in het daarvoor bestemde kader.

Wil ik dit formulier afdrukken, dan opent zich het rapport.
In dit rapport wordt WEL de juiste naam van de afbeelding geplaatst, alleen wordt de afbeelding NIET weergegeven.

Code in het rapport voor het oproepen van de afbeelding:

Function setImagePath()
Dim strImagePath As String
Dim strImagePath1 As String
Dim strImagePath2 As String
Dim strImagePath3 As String
Dim strImagePath4 As String
Dim strImagePath5 As String
Dim strImagePath6 As String
Dim strImagePath7 As String
Dim strMDBPath As String
Dim intSlashLoc As String

On Error GoTo PictureNotAvailable

'Het volledige pad van de huidige database of het huidige project van Access bepalen
strMDBPath = CurrentProject.FullName

'De locatie van de laatste backslash zoeken
intSlashLoc = InStrRev(strMDBPath, "\", Len(strMDBPath))

'De naam van de database verwijderen, zodat het pad overblijft
'en de naam van het afbeeldingsbestand toevoegen
strImagePath = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName
strImagePath1 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName1
strImagePath2 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName2
strImagePath3 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName3
strImagePath4 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName4
strImagePath5 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName5
strImagePath6 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName6
strImagePath7 = Left(strMDBPath, intSlashLoc) & "\Pictures\Cilinders\" & _
Me.txtImageName7

'ImageFrame instellen op het pad van het afbeeldingsbestand
Me.ImageFrame.Picture = strImagePath
Me.ImageFrame1.Picture = strImagePath1
Me.ImageFrame2.Picture = strImagePath2
Me.ImageFrame3.Picture = strImagePath3
Me.ImageFrame4.Picture = strImagePath4
Me.ImageFrame5.Picture = strImagePath5
Me.ImageFrame6.Picture = strImagePath6
Me.ImageFrame7.Picture = strImagePath7

Exit Function

PictureNotAvailable:
strImagePath = noImage
Me.ImageFrame.Picture = strImagePath

End Function

Wie o wie kan mij vertellen waar de miscommunicatie zit?

 

[OctaFish]

Om te beginnen: je hebt een mooie functie ergens vandaan gehaald, die je helemaal niet nodig hebt
Deze code kun je gewoon gebruiken om een pad op te halen:
Application.CurrentProject.Path & "\"

Verder zou ik met een loopje door je afbeeldingen lopen. Je hele code kan dan worden vervangen door deze 5 regels:

    GetPad = Application.CurrentProject.Path & "\Pictures\Cilinders\"""
    For i = 1 To 8
        strImagePath = GetPad & Me("txtImageName" & i)
        Me("ImageFrame" & i).Picture = strImagePath
    Next i

Waarom hij niet werkt? Daar zal ik nog even een blik op werpen; zonder voorbeeldje is dat een beetje lastig. En tijdrovend....

 

[ErikKEN]

Database plaatwerkdelen

 

[OctaFish]

't Is jammer genoeg een 2007 db; ik kan er derhalve pas vanavond naar kijken...

 

[ErikKEN]

Hier kan een slotje op, heb het probleem zelf verholpen en nu werkt het naar behoren.

 

[OctaFish]

Je mag hem helemaal zelf afsluiten, door 'm op <Opgelost> te zetten. Bovendien is het wel zo netjes om aan te geven hoe je het hebt opgelost; het is tenslotte de bedoeling van het forum om oplossingen door te geven aan elkaar... Nu weet alleen maar dat het probleem weg is, maar niet hoe...

 

[ErikKEN]

Ik heb de code uit het formulier gekopieërd en nu functioneert hij dus wel

Option Compare Database

Private Sub Report_Load()

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

If IsNull(Me!txtPicture3) Or Me!txtPicture3 = "" Then
'do nothing
Else
Me!Picture3.Picture = GetPathPart & Me!txtPicture3
End If

If IsNull(Me!txtPicture4) Or Me!txtPicture4 = "" Then
'do nothing
Else
Me!Picture4.Picture = GetPathPart & Me!txtPicture4
End If

If IsNull(Me!txtPicture5) Or Me!txtPicture5 = "" Then
'do nothing
Else
Me!Picture5.Picture = GetPathPart & Me!txtPicture5
End If

If IsNull(Me!txtPicture6) Or Me!txtPicture6 = "" Then
'do nothing
Else
Me!Picture6.Picture = GetPathPart & Me!txtPicture6
End If

If IsNull(Me!txtPicture7) Or Me!txtPicture7 = "" Then
'do nothing
Else
Me!Picture7.Picture = GetPathPart & Me!txtPicture7
End If

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) & "\Pictures\Schalen\"

End Function

 

[OctaFish]

Als je de tekstvakken een beetje slim benoemt (en dat heb je dus niet gedaan) dan kan de hele code worden teruggebracht tot dit:

For i = 1 To 8
    If Not Nz(Me("txtPicture" & i, "")) = "" Then
        Me("Picture" & i).Picture = GetPathPart & Me("txtPicture" & i)
    End If
Next i

Goed programmeren is meer dan copy-paste