Foto vanuit netwerkmap in Excel via macro

[MMarie]

Hallo,

ik ben geen expert in Excel maar ik ben al een eind op weg met wat ik wil. Toch denk ik nog hulp nodig te hebben.

Ik heb een bestand met een dropdown menu. De bedoeling is dat wanneer ik een selectie maak van een bepaald nummer in het menu de juiste foto in excel terecht komt.
Dit werkt als ik een map heb waar alle foto's in staan met bestandsnaam van dit zelfde nummer.

Echter de foto's staan in (heel veel) mappen met de nummers als naam en daaronder staat 1 of meer foto's met een straatnaam (dus niet het nummer).

Wat ik dus zou willen is:
1. als je het nummer selecteert gaat hij naar de betreffende map met dat nummer
2. hij pakt de eerste foto in die map ongeacht de naam (en ongeacht hoeveel foto's er in staan).

Ik weet niet of dit mogelijk is, want anders moeten alle foto's (en het zijn er een stuk of 50.000) in 1 map gaan zetten en hernoemen.

Ik voeg het bestand bij.

Ik hoop dat iemand het snapt en mij kan helpen!

Goetjes,
Marie

Bekijk bijlage 0 Voorblad met Complexfoto test.xlsm

 

[edmoor]

Ik zou het anders schrijven, maar het werkt hier prima in je eigen document als ik het netwerkpad en de naam van het JPG bestand aanpas naar een eigen bestaande omgeving. Hij pakt dus de gekozen foto uit die map en niet de eerste foto. Ik zou zo niet kunnen zeggen waarom dat bij jou niet goed gaat.

 

[MMarie]

Hoi,

Bedankt voor je reactie.
misschien ben ik niet duidelijk genoeg geweest. Bij mij werkt het ook op deze manier, maar ik ben dan gebonden aan die ene map, waar ik alle foto's in moet zetten en dan moet ik de foto's ook nog hernomen gelijk aan het nummer die ik opvraag.
Nu is het geval zo dat de foto in een map met het nummer staat, en daaronder een foto met een andere bestandsnaam (is dus variabel) Dus nu is de volgende map in de macro genoemd:
G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters maar eigenlijk zou ik dus willen dat hij zoekt naar een map met het juiste nummer G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters\F21-3002102(deze is dus variabel afhankelijk van de dropdown) en daarin een foto pakt in die map gemaand adres1

 

[edmoor]

Ik kan het niet makkelijk testen, maar probeer het eens zo:

Private Sub cmdFotoOpvragen_Click()
    Dim Foto As String
    Dim myObj
    Dim Pictur
    
    Application.ScreenUpdating = False
    
    On Local Error Resume Next
    Set myObj = ActiveSheet.DrawingObjects
    For Each Pictur In myObj
        If Left(Pictur.Name, 7) = "Picture" Then
            Pictur.Select
            Pictur.Delete
        End If
    Next
    On Local Error GoTo 0
    
    Foto = "G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters\" & Range("H3") & "\adres1.jpg"
    If Dir(Foto) <> "" Then
        ActiveSheet.Shapes.AddPicture Filename:=Foto, _
            linktofile:=msoFalse, _
            savewithdocument:=msoTrue, _
            Left:=230, _
            Top:=130, _
            Width:=325, _
            Height:=325
    Else
        MsgBox "Foto is niet beschikbaar"
    End If
    Application.ScreenUpdating = True
End Sub

 

[MMarie]

Ik krijg de melding "Foto is niet beschikbaar". Heb ook geprobeerd adres1 weg te laten, werkt ook niet.
Heb je nog ideeen? Overigens is de naam van foto ook variabel, heeft verschillende namen, ik gaf als voorbeeld adres 1, maar in een andere map kan het adres2 zijn.

Hij werkt wel als ik de foto adres1 noemt, dus macro werkt verder goed, alleen nog de variabele in fotonaam?

 

[snb]

Hoe beter gestructureerd je data/bestandspaden/bestandsnamen, hoe robuuster je code.
Even progammeertaal kan weinig to nites met 'fuzzy' gegevens.
Besteed liever aandacht aan het goed structureren van de werkomgeving dan aan het compliceren van code.

 

[edmoor]

Ik krijg de melding "Foto is niet beschikbaar". Heb ook geprobeerd adres1 weg te laten, werkt ook niet.
Heb je nog ideeen? Overigens is de naam van foto ook variabel, heeft verschillende namen, ik gaf als voorbeeld adres 1, maar in een andere map kan het adres2 zijn.

Hij werkt wel als ik de foto adres1 noemt, dus macro werkt verder goed, alleen nog de variabele in fotonaam?

Dan was je voorbeeld dus niet goed. De code is conform je vraag.
De naam van de foto kan je ook in een cel opnemen, of evt. laten kiezen door de gebruiker.

 

[MMarie]

Dan was je voorbeeld dus niet goed. De code is conform je vraag.
De naam van de foto kan je ook in een cel opnemen, of evt. laten kiezen door de gebruiker.

Klopt mijn voorbeeld was niet goed. Ben al blij met de selectie van de juiste map. Ik snap alleen niet met hoe de gebruiker de juiste foto zou kunnen kiezen?

 

[MMarie]

Hoe beter gestructureerd je data/bestandspaden/bestandsnamen, hoe robuuster je code.
Even progammeertaal kan weinig to nites met 'fuzzy' gegevens.
Besteed liever aandacht aan het goed structureren van de werkomgeving dan aan het compliceren van code.

Je hebt helemaal gelijk. In mijn werkomgeving mag ik niet zomaar alles aanpassen in de structuur. IN dit geval zou het wel kunnen maar het zijn ruim 1.400 mappen met daaronder 1 of meerdere foto's, Je begrijpt dat dit best wel een klus is om aan te pakken

 

[snb]

SVP niet citeren !

Ook dat kunnen we automatiseren.
Als je de mappenstruktuur vertelt....

Bijv alle foto's in deze directory en onderliggende directories:

sn=split(createobject("wscript.shell").exec("cmd /c dir ""G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters\*.jpg"" /b/s").stdout.readall,vbcrlf)

 

[MMarie]

Mappenstructuur (voor de test) is als volgt:



De mappen beginnend met een F selecteer je met een dropdown menu. Als je het juiste F nummer hebt geselecteerd moet de macro er dus voor zorgen dat hij in de map met datzelfde F nummer kijkt en daar 1 foto pakt en invoegt in excel.

 

[snb]

Nee, ik bedoelde de deze mappen:

IN dit geval zou het wel kunnen maar het zijn ruim 1.400 mappen met daaronder 1 of meerdere foto's

Dan zorgen we ervoor dat al deze foto's in 1 directory komen te staan (dan hoeft de gebruiker niets te selecteren).

 

[MMarie]

De structuur is hetzelfde, ik heb m alleen voor het testen van de macro simpeler gemaakt maar er staan ruim 1.400 mappen met verschillende F nummers en onder elke map foto's met namen die allemaal varieren.

Als je ze onder 1 map zet zou dat fijn zijn, maar dan hebben ze nog niet de juiste naam. Hoe weet de macro welke foto juist is. De fotonaam moet dan gelijk zijn aan de mapnummer erboven (F...). En wat als er meerdere foto's in de map zitten...

 

[snb]

En wat als er meerdere foto's in de map zitten...

Dat is een beslissing die jij moet nemen. Mijn voorstel zou dan gewoon zijn de mapnaam + een volgnummer van 3 cijfers.
bijv. mapnaam_001,jpg, mapnaam_002.jpg, mapnaam_003.jpg


we zetten de foto' in map

G:\LDN\Assetmanagement\Complexbeheerplannen\fotoos.
Dan moet je hiermee een eind kunnen komen:

sub M_snb()
  c00="G:\LDN\Assetmanagement\Complexbeheerplannen\fotoos\"

  with createobject("wscript.shell")
    sn=split(.exec("cmd /c dir G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters\*.jpg /b/s").stdout.readall,vbcrlf)

    for j=0 to ubound(sn)-1
      st=split(sn(j),"\")
      c01=st(ubound(st)-1)
      filecopy sn(j), c00 & c01 & Format(UBound(Split(.exec("cmd /c dir """ & c00 & c01 & "*.jpg"" /b").stdout.readall, vbCrLf)) + 1, "_000")
    next
  end with
End Sub

 

[MMarie]

Ik ben niet veel met macro's bezig dus weet niet goed waar ik deze code moet zetten.
Zet ik dit in de huidige macro en zo ja waar? Als ik m een nieuw bestand zet krijg ik de melding 'Het sunscript valt buiten bereik".

 

[snb]

Het maakt niet uit waar je deze code zet.

Je moet eerst een map aanmaken voor de foto's.

Je moet natuurlijk wel het pad:

G:\LDN\Assetmanagement\Complexbeheerplannen\Format\test\Clusters\*.jpg

en het pad voor de foto's in de macro aanpassen.

En maak er een gewoonte van om, als er een fout optreedt, aan te geven in welke regel van de code.

 

[MMarie]

map is aangemaakt en voorgestelde nummering lijkt me prima.
Het pad in de macro is aangepast maar waar zet ik jouw code?

Private Sub cmdFotoOpvragen_Click()
Application.ScreenUpdating = False

Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If

Next

Dim ClusterNummer As String, T As String

mydir = "G:\LDN\Assetmanagement\Complexbeheerplannen\fotoos\"
ClusterNummer = Range("H3")
T = ".jpg"

On Error GoTo ErrorMessage:
ActiveSheet.Shapes.AddPicture Filename:=mydir & ClusterNummer & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=230, Top:=130, Width:=325, Height:=325

ErrorMessage:
If Err.Number = 1004 Then
MsgBox "Foto is niet beschikbaar"

End If

Application.ScreenUpdating = True

End Sub

 

[snb]

Je moet mijn macro afzonderlijk uitvoeren.

 

[MMarie]

Heb m in een afzonderlijk bestand uitgevoerd en hij geeft "Fout 9 tijdens opsporing. Het subscript valt buiten het bereik"

Bij foutopsporing gaat ie naar de regel

c01 = st(UBound(st) - 1)

 

[snb]

Pas dan deze regel aan:

st=split(sn(j),"\")