Foto s op vooblad, herhalen als blad nog niet vol is

[snb]

1. zet in het werkblad bij het artikel zonder foto het pad naar de afbeelding "geen_foto.jpg"
2. zorg ervoor dat er een afbeelding in de map met afbeeldingen staat met de naam 'geen_foto.jpg"
3. reduceer je code tot:

Sub MM_snb()
  sn = Sheets("Lijst").Cells(1).CurrentRegion
    
  With Sheets("lijst").Cells(1, 100).Resize(UBound(sn))
    .Formula = "=rand()"
    st = Evaluate("index(rank(" & .Address & "," & .Address & "),)")
    .Columns(100).ClearContents
  End With

  With Sheets("Voorblad")
    For j = 0 To 175
      .Shapes.AddPicture "P:\automatisering\mijn afbeeldingen\Website afbeeldingen\472 DS_Photo\" & sn(st(j Mod UBound(sn) + 1, 1), 1) & ".jpg", 0, 1, .Columns(j Mod 11 + 1).Left + 4, .Rows(j \ 11 + 1).Top + 4, 35, 35
    Next
  End With
End Sub

 

[HWV]

Beste SNB,

1) Ik weet niet van te voren of de foto wel of niet gemaakt is.(op 12.000 artikelen heb ik er nu pas denk ik 8.000 stuks)
Dat kan ik met het vullen van de lijst met het klantenassortiment niet zien.

Ik kan het artikel dus niet zodanig benoemen met Geen_foto.jpg

2) Deze staat in de zelfde map als de rest van de foto`s

3) Code aangepast zoals u heeft aangegeven

HWV

 

[snb]

dan komen we uit op:

Sub MM_snb()
  sn = Sheets("Lijst").Cells(1).CurrentRegion
  c00="P:\automatisering\mijn afbeeldingen\Website afbeeldingen\472 DS_Photo\"

  With Sheets("lijst").Cells(1, 100).Resize(UBound(sn))
    .Formula = "=rand()"
    st = Evaluate("index(rank(" & .Address & "," & .Address & "),)")
    .Columns(100).ClearContents
  End With

  With Sheets("Voorblad")
    For j = 0 To 175
      c01=c00 & sn(st(j Mod UBound(sn) + 1, 1), 1) & ".jpg"
      .Shapes.AddPicture iif(dir(c01)="",c00 & "geen_foto.jpg",c01), 0, 1, .Columns(j Mod 11 + 1).Left + 4, .Rows(j \ 11 + 1).Top + 4, 35, 35
    Next
  End With
End Sub

 

[HWV]

SNB bedankt voor uw bericht en inzet

Ik heb de code gedraaid in het originele bestand maar geeft een fout op het rode gedeelte:

Sub MM_snb()
  sn = Sheets("Lijst").Cells(1).CurrentRegion
  c00 = "P:\automatisering\mijn afbeeldingen\Website afbeeldingen\472 DS_Photo\"

  With Sheets("lijst").Cells(1, 100).Resize(UBound(sn))
    .Formula = "=rand()"
    st = Evaluate("index(rank(" & .Address & "," & .Address & "),)")
    .Columns(100).ClearContents
  End With

  With Sheets("Voorblad")
    For j = 0 To 175
   [COLOR="#FF0000"]   c01 = c00 & sn(st(j Mod UBound(sn) + 1, 1), 1) & ".jpg"[/COLOR]
      .Shapes.AddPicture IIf(Dir(c01) = "", c00 & "geen_foto.jpg", c01), 0, 1, .Columns(j Mod 11 + 1).Left + 4, .Rows(j \ 11 + 1).Top + 4, 35, 35
    Next
  End With
End Sub

 

[snb]

Leer eens te debuggen:
als de code stopt en de gestopte regel is geel :

ga met de cursor boven sn( hangen en kijk naar de waarde van sn
ga met de cursor boven st( hangen en kijk naar de waarde van st
ga met de cursor boven de j hangen en kijk naar de waarde van j

 

[HWV]

Hieronder het geen wat u vroeg:

ga met de cursor boven sn( hangen en kijk naar de waarde van sn
"Typen komen niet met elkaar overeen"
ga met de cursor boven st( hangen en kijk naar de waarde van st
"Fout 2042"
ga met de cursor boven de j hangen en kijk naar de waarde van j
"0"

Dit heb mij aan het denken gezet, doordat er niks werd gevonden. Moest het eigenlijk wel liggen aan dat hij de sheet lijst niet ziet
Klink raar met ik heb de regel in het rood toegevoegd en hij draait als een zonnetje.

Daarin tegen geef u ook aan dat deze regel overbodig, en ik deze niet meer mocht gebruiken.

Sub MMM_snb()

[COLOR="#FF0000"] Sheets("Lijst").Select[/COLOR]
 
  sn = Sheets("Lijst").Cells(1).CurrentRegion
  c00 = "P:\automatisering\mijn afbeeldingen\Website afbeeldingen\472 DS_Photo\"

  With Sheets("lijst").Cells(1, 100).Resize(UBound(sn))
    .Formula = "=rand()"
    st = Evaluate("index(rank(" & .Address & "," & .Address & "),)")
    .Columns(100).ClearContents
  End With

  With Sheets("Voorblad")
    For j = 0 To 175
      c01 = c00 & sn(st(j Mod UBound(sn) + 1, 1), 1) & ".jpg"
      .Shapes.AddPicture IIf(Dir(c01) = "", c00 & "geen_foto.jpg", c01), 0, 1, .Columns(j Mod 11 + 1).Left + 4, .Rows(j \ 11 + 1).Top + 4, 35, 35
    Next
  End With
End Sub

 

[snb]

Wat gebeurt er met deze code ? (svp niets aan wijzigen)

Sub M_snb()
  sn = Sheets("Lijst").Cells(1).CurrentRegion
  c00 = "P:\automatisering\mijn afbeeldingen\Website afbeeldingen\472 DS_Photo\"

  With Sheets("lijst").Cells(1, 100).Resize(UBound(sn))
    .Formula = "=rand()"
    st = Evaluate("index(rank(Lijst!" & .Address & ",Lijst!" & .Address & "),)")
    .ClearContents
  End With

  With Sheets("Voorblad")
    For j = 0 To 175
      c01 = c00 & sn(st(j Mod UBound(sn) + 1, 1), 1) & ".jpg"
      .Shapes.AddPicture IIf(Dir(c01) = "", c00 & "geen_foto.jpg", c01), 0, 1, .Columns(j Mod 11 + 1).Left + 4, .Rows(j \ 11 + 1).Top + 4, 35, 35
    Next
  End With
End Sub

 

[HWV]

Beste SNB,

Draait perfect en idd zonder " Sheets("Lijst").Select"
Ik had hier nooit kunnen komen zonder deze hulp hier op het forum met U in het bijzonder SNB

Heel erg dank voor de aangeboden hulp

HWV