Hyperlink naar foto's

[Jackson1]

Hallo Allemaal,

Ik ben een database aan het maken en daarin wil ik per idem een afbeelding plaatsen. Om te voorkomen dat de database te groot wordt heb wil een link maken naar de afbeelding die geladen moet worden. Dankzij een voorbeeld dat ik op internet heb gevonden is dit gelukt (zie bijlage voor het voorbeeld). Met het aanmaken van een nieuw idem kan ik met de browse button de link naar de afbeelding maken. Dit werkt perfect.

Nu is het alleen zo dat de database op meerdere standalone computers gebruikt wordt. Het "pad" naar de afbeeling en is dus steeds anders en dan werken de afbeelingen niet meer.

De database hem ik in dezelfde map staan als de afbeelingen en deze map (met de afbeelingen en de database) word op verschillde computers gebruikt.

Weet iemand wat ik hier aan kan doen?

Alvast bedankt!

 

[Greenery80]

Bijlage?

Welke bijlage?

 

[OctaFish]

Als je de afbeeldingen steeds in dezelfde map bewaart als de database, kun je een variabele gebruiken voor het pad van de afbeeldingen:

Path = CurrentProject.Path

Michel

 

[Jackson1]

Bijlage

Hierbij alsnog de bijlage

Octafish bedankt voor de code. Ik ben alleen niet zo bekend met codes en weet niet hoe en waar ik hem moet gebruiken.

Is het ook mogelijk om net als in het voorbeeld uit de bijlage het bestand via browse te selecteren of moet ik steeds per het path in een code verwerken.

Bedankt

 

[Greenery80]

Path

Ik had al zo'n vermoeden dat je wat was vergeten.

De code wordt als volgt bij Form_Open en Form_Current:

CurrentProject.Path & "\" & Me!txtPicture

Tevens heb ik de volgende code veranderd bij CmdBrowse_Click:

Me![txtPicture] = GetOpenFile_CLT(CurrentProject.Path, "Select the File")
Me![txtPicture] = Mid(Me![txtPicture], InStrRev(Me![txtPicture], "\") + 1)

Let wel plaatjes moeten altijd in de PictDatabase2000 directory staan.

 

[Jackson1]

Greenery80,

Bedankt voor het aanpassen van het voorbeeld:thumb:. Het voorbeeld werkt perfect!

Ik heb gelijk alles zo goed mogelijk naar mijn database over gekopieerd maar krijg nu de foutmelding "Compileerfout: Sub of Function is niet gedefineerd" op GetOpenFile_CLT.

Ik weet niet waar het door komt. Om er voor te zorgen dat ik alles zo goed mogelijk overnam heb ik alles letterlijk over proberen te kopieren. Ik heb in de tabel een veld met Picture aangemaakt en ik heb de velden uit jou voorbeeld form letterlijk gekopieerd naar mijn form. Vervolgens heb ik jou code uit VBA overgekopieerd naar mijn formulier.

Ik heb nog niet zoveel ervaring met ingewikkelde functies in Access misschien dat ik iets over het hoofd heb gezien.
______________________________

Jelle

 

[OctaFish]

Als je in de voorbeelddatabase kijkt, zie je in de groep Modules een module staan met de naam <basOpenFile>. Die moet je ook naar je eigen database kopieëren.

Michel

 

[Jackson1]

Mission completed

Het werkt

Octafish & Greenery bedankt voor jullie hulp!!!

Zonder jullie zou me dit niet gelukt zijn:thumb:

Bedankt!

 

[Jackson1]

Octafish & Greenery,

Ik wil niet te veel van jullie vragen maar weten jullie of het ook mogelijk is om de afbeeling te vergroten door erop te klikken?

Mocht het niet mogelijk zijn dan ben ik nog steeds zeer tevreden met mijn huidige base:thumb:

 

[Greenery80]

Ik heb weinig ervaring hiermee.
Maar het is wel een beetje afhankelijk van wat je wilt...

Wil je inzoomen op de foto? (week nie of dit kan)
Of wil je de foto aanpassen aan de grootte van het veld? (week zo ff nie)
Of wil je de foto openen in standaard pictureviewer in windows? (week wel)

Voeg dit toe aan je vba code:

Private Sub Picture_Click()

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

End Sub

Dit lijkt mij ook handig bij plaatjes bewerken, tenminste als je standaard pictureviewer ook een bewerkingsprogramma is.

 

[Jackson1]

Het werkt

Greenery80,

Ik denk dat inderdaad de laatste optie ook het handigst is. Ik heb de code toepgepast en alles werkt perfect Echt ongeloofelijk wat er allemaal mogelijk is met access!
Ik vind het wel vervelend om zoveel aan jullie te vragen maar ik heb nog 1 klein vraagje.

Is het mogelijk om niet steeds een foutmelding te krijgen als de database wordt geopend zonder afbeeldingen. Het zal niet vaak gebeuren maar het kan wel eens gebeuren dat de database even snel gemaild word om snel wat data te bekijken.

Bedankt!

 

[Bakk4318]

@Jackson1,

Als je laatste vraag opgelost is en dat kan, dan blijf je met nog een probleem zitten. Kijk maar eens wat er gebeurd als je browsed naar een foto en je selecteerd vervolgens geen foto en je klikt op "Annuleren. Dan krijg je ook een foutmelding.

Op onderstaande link staat ook een voorbeeld van een database met foto's gekoppeld aan een record. Hier wordt ook nog eens alles stap voor stap uitgelegd.

Wat je nu zoekt vind je links in het menu bij "Gemak" ---> "Afbeeldingen".

http://www.accesspower.nl/

Er staan ook nog hele mooie andere voorbeelden. Kan altijd van pas komen, dus bewaren die link.

Succes.

 

[Greenery80]

Thnx, Bakk4318 voor de aanvulling.
De foutmelding was mij nog niet opgevallen. :thumb:

Je hebt gelijk dat openfiledialog zeker een goede optie is.
Dit is bovenal makkelijker te begrijpen dan de code in het voorbeeld bestand van Jackson.

Maar ... ik zit nu toevallig achter een (hele oude) pc met windows 2000 professional.
En het voorbeeld van accesspower doet het niet (dit wist ik ook al). Op mn andere pc's doet ie het wel (XP en Vista).
openfiledialog werkt op bijna alle platformen, behalve 2000 en 95.
MSDN

Maar wat ik wou zeggen... Als je gebruikers niet op (sterk) verouderde systemen werken (en die kans is zeer groot -> 2000 (en lager) is minder dan 5% vd markt) gebruik dan zeker de oplossing van Bakk4318!

Anders workaround voor annuleer fout:

Dim sPicture As String

    sPicture = GetOpenFile_CLT(CurrentProject.Path, "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
    End If

@ Jackson: Antwoord op je eerdere vraag:
De foutmelding die je krijgt bij het openen van de database is correct.
Er wordt eigenlijk gemeld dat er wel afbeeldingen in de tabel staan, maar dat deze afbeeldingen niet zijn meegeleverd. En dit klopt.

 

[OctaFish]

Ik heb voor jouw laatste vraag wel een oplossing, die ik onlangs voor iemand heb gemaakt: een apart formulier, waar je de foto inzet. Dit formulier wordt geactiveerd als je op de huidige foto klikt. Bedoel je zoiets?

Michel

 

[Jackson1]

Bedankt voor jullie reacties!

Octafish: Bedankt voor je aanbod maar ik ben genoeg geholpen met de oplossing van Greenery80

Greenery80: Bedankt voor de aanvullende code werkt perfect!

Bakk4318: Bedankt voor de link.

Ik het het voorbeeld van de link (zie ook bijlage) en de tekst van de website goed doorgenomen. Ik vind het een erg goed voorbeeld maar omdat mijn database al goed werkt wil ik eigenlijk alleen het textveldtje "Afbeeling is verwijderd of heeft een andere naam gekregen" in mijn database hebben ipv de popup met de foutmelding. Ik heb het textveldje uit het formulier van het voorbeeld gekopieerd naar mijn database en een gedeelte van de code uit het voorbeeld in mijn VBA code een plaats proberen te geven. Ik heb niet zoveel verstand van VBA maar volgens mij is het de volgende "aanvulling".

    Select Case Err.Number
    
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "De foto is verwijderd of heeft een andere naam gekregen."

Ik heb hem op diverse plaatsen proberen te plaatsen maar zonder resultaat. Weet iemand waar ik de code moet plaatsen en of dit wel het juiste gedeelte van de code is voor het de tekst weer te geven ipv de foutmelding?

 

[OctaFish]

Ik weet niet of je hem hebt getest, maar bij mij doet-ie het gewoon.

Michel

 

[Jackson1]

Octafish bedankt voor je reactie,

Het voorbeeld uit de laatse bijlage werkt ook perfect. Het is alleen dat mijn database (dus niet het voorbeeld uit de laatste bijlage) een foutmeding door middel van een pop-up geeft als hij de afbeelding niet kan vinden. (dit vind ik veel minder hinderlijk als steeds een pop-up) De datebase uit het voorbeeld geeft een text in een textveld ipv een foutmelding door. Nu weet ik niet precies welk gedeelte van de code van het voorbeeld er verantwoordelijk voor is dat er geen foutmelding komt maar een text in een textveld. En ik weet ook niet waar ik deze precies moet plaatsen in mijn code (ik denk dat het om het blauwe gedeeltje gaat maar weet het niet zeker. Zie onder voor de code uit mijn database en de database van het voorbeeld:

Code van mijn database:

Option 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
    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
    Else
        Me!Picture.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 = CurrentProject.Path & "\Afbeeldingen" & "\" & Me!txtPicture
    End If
            
Exit_Form_Open:
    Exit Sub
    
Err_Form_Open:
    MsgBox Err.Description
    Resume Exit_Form_Open
        
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

Code van de voorbeeld database:

Private Sub cmdInsertImage_Click()
On Error GoTo err_cmdInsertImage_Click
'Code om foto toe te voegen

    Dim dlgPicker As FileDialog
    Dim strFileName As String
    Dim strPath As String
    Dim strFile As String
    
    If IsNull(Me.txbPersoon_Personeelsnummer) Then
        MsgBox "Vul eerst een personeelsnummer in.", vbCritical + vbOKOnly, "Fout"
        Exit Sub
    End If
    
    'Open de Windows bestandenlijst, met als argument het type
    Set dlgPicker = Application.FileDialog(msoFileDialogFilePicker)
    
    With dlgPicker
        .Title = "Selecteer een foto." 'De titel voor het venster
        '*************************************
        'Pas dit aan voor map met afbeeldingen
        '*************************************
        .InitialFileName = CurrentProject.Path 'Waar moet het venster beginnen?
        .Filters.Add "JPG", "*.jpg", 1 'Beperk de bestandstypes tot .jpg, en maak dat het eerste item in de lijst
        .AllowMultiSelect = False 'Slechts één bestand kiezen toegestaan
        .InitialView = msoFileDialogViewPreview 'Bepaal weergave
        
        If .Show = -1 Then 'Bepaal of gebruiker op OK-knop heeft geklikt.
            strFileName = .SelectedItems.Item(1) 'String wordt gevuld met geselecteerde bestand
        End If
        
    End With

    '*************************************
    'Pas dit aan voor map met afbeeldingen
    '*************************************
    strPath = CurrentProject.Path & "\"
    
    Name strFileName As strPath & Me.txbPersoon_Personeelsnummer & ".jpg"
    
    Me.chkPersoon_FotoBeschikbaar = True
    
    Me.imgFoto.Visible = True
    Me.imgFoto.Picture = strPath & Me.txbPersoon_Personeelsnummer & ".jpg"
    Me.txbFoutmelding.Visible = False

    Exit Sub

err_cmdInsertImage_Click:
    Select Case Err.Number
        Case 58 'Het bestand bestaat al.
            MsgBox "Er bestaat al een foto voor deze persoon (" & Me.txbPersoon_Personeelsnummer & ".jpg). Kies dit bestand, of hernoem dit.", vbCritical + vbOKOnly, "Fout"
        Case 75 'De gebruiker klikt op de knop Annuleren.
            MsgBox "U hebt geen foto geselecteerd.", vbOKOnly + vbInformation, "Melding"
        Case Else 'Overige gevallen
            MsgBox "Fout in: " & "cmdInsertImage_Click, foutnummer:" & Err.Number & ", " & Err.Description
    End Select
    
    Exit Sub
    
End Sub

Private Sub cmdOK_Click()

    DoCmd.Close acForm, Me.Name, acSaveYes

End Sub

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

    If Me.chkPersoon_FotoBeschikbaar = True Then
        '*************************************
        'Pas dit aan met map voor afbeeldingen
        '*************************************
        Me.imgFoto.Picture = CurrentProject.Path & "\" & Me.txbPersoon_Personeelsnummer & ".jpg"
        Me.imgFoto.Visible = True
    
    Else
    
        Me.imgFoto.Visible = False
        Me.txbFoutmelding.Visible = False
    
    End If
    
    Exit Sub

err_Form_Open:
    
[COLOR="Blue"]    Select Case Err.Number
    
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "De foto is verwijderd of heeft een andere naam gekregen."[/COLOR]
            Me.imgFoto.Visible = False
            
        Case Else
            MsgBox Err.Number
            
    End Select
    
End Sub

 

[Pletter]

foto

Greenery80,

Dit is allemaal nieuw voor mij, maar het vergroten van een afbeelding is wel mogelijk.

Heb mij hier een poosje mee bezig gehouden en een base gemaakt die eigenlijk werkt als een viewer.

Bijkomend is dat men alleen bepaalde foto's in de bestemde map hoeven te zetten en Access dit in de betreffende tabel plaatst.

Bijkomend achter de schermen kan men no zelf een map aanmaken.

Laat maar horen of je interesse voor dit programma hebt.

Groet,

 

[Jackson1]

Gelukt!

Het is gelukt.

Zie de code hieronder. De code in het blauw heb ik aangepast. Dit was eerst ( MsgBox Err.Description)

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:

    [COLOR="RoyalBlue"]Select Case Err.Number
    
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "De foto is verwijderd of heeft een andere naam gekregen."

            
        Case Else
            MsgBox Err.Number
            
    End Select[/COLOR]
    Resume exit_Form_Current
End Sub

Ik wil jullie allemaal bedanken voor jullie tijd en hulp zonder julle was het zeker niet zo snel gelukt:thumb:

 

[OctaFish]

Het tekstvak op het formulier wordt gecheckt in de volgende procedure:

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
    End If
            
Exit_Form_Open:
    Exit Sub
    
err_Form_Open:
    Select Case Err.Number
        Case 2220 'De verwachte afbeeldingen is niet te vinden.
            Me.txbFoutmelding = "De foto is verwijderd of heeft een andere naam gekregen."
            Me.imgFoto.Visible = False
        Case Else
            MsgBox Err.Number & vblf & Err.Description
    End Select
        
End Sub

Oftewel: als je in het ontwerpscherm zit van je formulier, pak je de gebeurtenis <Bij Laden>.

Wel zorgen dat het tekstvak dezelfde naam heeft natuurlijk!

Michel