probleem met macro/VBA voor toevoegen foto's in excel

[mw22]

Goedendag,

ik hoop dat iemand mij hier kan helpen.

Een aantal jaren geleden heeft een oud-collega een template gemaakt voor het automatisch toevoegen van afbeeldingen van producten in een excel lijst op basis van de eancode van het artikel in die regel.
Nu werkt deze functie helaas niet meer nadat wij over zijn gegaan naar de laatste excel versie.
Zelf heb ik te weinig kennis om te zien waar dit aanligt en wat er aangepast moet worden.

Dit is de code :

Sub Insert_Pict1()

Dim Sh As Shape
With Worksheets("Indoor")
For Each Sh In .Shapes
If Not Application.Intersect(Sh.TopLeftCell, .Range("a21:a5000")) Is Nothing Then
If Sh.Type = msoPicture Then Sh.Delete
End If
Next Sh
End With

Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR"
myarray = WorksheetFunction.Transpose(Range("b21", Range("b" & Rows.Count).End(xlUp)).Value)
ActiveSheet.Protect False, False, False, False, False
If Not IsArray(myarray) Then Exit Sub
On Error Resume Next
lRow = 21
For lLoop = LBound(myarray) To UBound(myarray)
Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
Cells(2, 1).Left + 19, Cells(lRow, 2).Top + 8, 50, 50)
lRow = lRow + 1
Next lLoop
End Sub

Deze zorgt dus voor invoegen van afbeelding van het desbetreffende artikel en voor de maat van de afbeelding op basis van een lijst met o.a. ean-codes

De foutmelding geeft aan dat er een fout is opgetreden bij het importeren van het bestand. Ik heb gecheckt en de afbeeldingen staan gewoon allemaal in de juiste map met de juiste benaming

 

[AHulpje]

De melding:
"Er is een fout opgetreden bij het importeren van dit bestand"
kan veroorzaakt worden door een fout in de bestandsnaam, bijvoorbeeld een spatie aan het eind van de ean-code in kolom B21 en verder.
Je kunt dit snel controleren door direct onder

[COLOR=#333333]For lLoop = LBound(myarray) To UBound(myarray)[/COLOR]

deze regel in te voegen:

    MsgBox Afb_map & myarray(lLoop) & ".jpg"

 

[mw22]

ik heb dit toegevoegd maar krijg nu enkel nog een extra foutmelding naast de eerdere foutmelding:

 

[AHulpje]

Duidelijk.
Dit is je path:
"\\dco01\images\cc\2016_packshots ean LR" zoals opgegeven in de macro

en dit is de filenaam van je afbeelding die daar achter geplakt wordt:
"\.jpg"

Ik zou dus nog maar eens goed kijken naar de namen van je afbeeldingen die beginnen in cel B21 op werkblad "Indoor".
Ik ben trouwens wel benieuwd waar die backslash in de naam van de afbeelding vandaan komt.

 

[mw22]

de backslash is omdat deze verwijst naar een map op een gedeelde schijf en er is niets veranderd aan het document, de code, de locatie van de map, de locatie van het bestand waardoor dit nu niet meer zou moeten werken.

Het enige dat ik mij kan bedenken, dat dit is gemaakt in een oudere versie van excel en wij ondertussen 1 of 2 versies verder zijn waardoor er nu bepaalde delen van de VBA niet meer kloppen.

 

[AHulpje]

In de macro staat keihard geprogrammeerd:
Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR"
en daar verzint VBA echt geen backslash bij.

Wat staat er dan in cel B21 en daaronder op werkblad Indoor?

 

[jgkdrt]

mw,

Ik denk dat AHulpje bedoelt dat je het pad moet aan vullen met een backslash:

Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR"

moet worden

Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR\"

althans daar liep je code bij mij op fout.

 

[AHulpje]

Nee, dat bedoelde ik niet, zie namelijk de afbeelding in #3, daar staat wel degelijk een backslash.
Ik was dus benieuwd waar die vandaan komt.

 

[snb]

Zo dan:
Met een testregel die je aktief kunt maken door de apostrof te verwijderen.

Sub M_snb()
  c00 = "\\dco01\images\cc\2016_packshots ean LR\"
  sn = sheet1.usedrange.columns(2)
  If Not IsArray(sn) Then Exit Sub

  For j = 21 to  UBound(sn)
'   MsgBox c00 & sn(j,1) & ".jpg"
    if dir(c00 & sn(j,1) & ".jpg")<>"" then sheet1.Shapes.AddPicture(c00 & sn(j,1) & ".jpg", 0, -1, sheet1.Cells(2, 1).Left + 19, sheet1.Cells(j, 2).Top + 8, 50, 50)
  next
End Sub

 

[AHulpje]

Dat snb dol is op zo compact mogelijke code is mij inmiddels duidelijk ;-)
Maar hoe hij weet dat de TS een Engelstalige versie van Excel gebruikt en dat werkblad "Indoor" op sheet1 (of blad1?) staat is mij niet duidelijk.
Verder zou ik de Do Loop bij 1 laten beginnen i.p.v. 21.
En natuurlijk moet het pad afgesloten worden met een \, maar dat alles doet niets af aan het feit dat die er op enigerlei wijze (zie afbeelding in #3) wel tussen gezet wordt, vandaar mijn vraag wat er in cel B21 staat.
Ik heb het vermoeden dat TS misschien verouderde code heeft geplaatst?

 

[snb]

Ho,ho dat is geen Do-loop maar een For ... Next lus.
In de code van TS zie je dat de range begint bij B21; dus dat lijjkt me een aardig aangrijpingspunt.
Het gaat niet om 'dol op compact', maar op het principe van de spaarzaamheid (dat in de wiskunde leidend is).

 

[jgkdrt]

AHulpje,

Het lijkt erop dat, om wat voor reden dan ook, de laatste backslash standaard verdwijnt uit de tekst op het forum (misscien bij anderen al lang bekend?)
Als ik er 2 plaatst blijft er 1 over.

Hieronder test ik of het met de CODE-tag wel blijft staan (in beide gevallen sloot ik de string af met een backslash):


Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR"

Const Afb_map = "\\dco01\images\cc\2016_packshots ean LR\"

Dat blijkt inderdaad het geval te zijn.

 

[AHulpje]

@jgkdrt
Dat verklaart een hoop! Daar zou ik nou nooit opgekomen zijn, slim gevonden. Ik werd dus helemaal op het verkeerde been gezet. Dank voor deze uitleg.


@snb
Was geen kritiek hoor, vind het juist wel interessant die compacte code.
Maar soms ga ik toch voor leesbaarheid, voor beginners is die compacte code soms wat lastiger te interpreteren.
En ach ja, een For-next lus is geen Do-loop, daar heb je helemaal gelijk in, verschrijving mijnerzijds.


Maar de ondergrens van die For-next lus snap ik niet.
Stel dat kolom B gevuld is vanaf rij 21 t/m bijvoorbeeld rij 100 met ean-codes en B1 t/m B20 zijn leeg, dan bevat sn:
sn = sheet1.usedrange.columns(2)
toch de inhoud van B21 t/m B100?
Dan bevat het eerste element van sn toch de inhoud van B21 en moet de for-next loop lopen van 1 t/m Ubound(sn) en niet van 21 t/m Ubound(sn)?
Althans, zo werkte dat in mijn testomgeving.


Maar ik moet toegeven dat de code van TS wel verwarrend werkt, daar wordt myarray wel doorlopen van LBound(myarray) To UBound(myarray), maar er wordt ook stiekem gebruik gemaakt van het rijnummer IRow, dat begint bij 21 en in de lus telkens met 1 opgehoogd wordt.

 

[mw22]

Zo dan:
Met een testregel die je aktief kunt maken door de apostrof te verwijderen.

Sub M_snb()
  c00 = "\\dco01\images\cc\2016_packshots ean LR\"
  sn = sheet1.usedrange.columns(2)
  If Not IsArray(sn) Then Exit Sub

  For j = 21 to  UBound(sn)
'   MsgBox c00 & sn(j,1) & ".jpg"
    if dir(c00 & sn(j,1) & ".jpg")<>"" then sheet1.Shapes.AddPicture(c00 & sn(j,1) & ".jpg", 0, -1, sheet1.Cells(2, 1).Left + 19, sheet1.Cells(j, 2).Top + 8, 50, 50)
  next
End Sub

Bedankt allemaal voor jullie hulp! De code is geschreven door een oud-collega en ik heb er zelf te weinig verstand van om dit op te lossen, dus wanneer de code efficiënter kan, dan zou dat ook fijn zijn. Kan ik dan de bovenstaande code gebruiken hiervoor? Het document bestaat uit 3 tabbladen waar op ieder tabblad deze macro staat om de assortimentslijsten te maken per categorie: indoor, outdoor, stands&displays. Kan ik deze dan op ieder tabblad zo toevoegen of moet er dan nog een soort verwijzing naar het juiste tabblad gebeuren?

Gisteren werkte de macro wel maar net weer getest en ik krijg deze melding en deze afbeelding staat wel in de juiste map met naam eancode.jpg

 

[snb]

Hallo,

Jullie berdrijf heeft een probleem.
Om dat probleem op te lossen is gedetailleerde informatie van het bestand waarmee je werkt noodzakelijk.
Als je die informatie niet via een openbaar forum wil/mag delen, zul je een dienstverlener moeten inschakelen die aan geheimhouding gebonden kan worden.
Dat is geen ongebruikelijke gang van zaken in dit soort situaties.
Wellicht kun je iemand in dit forum daarvoor benaderen.