Excel crasht bij macro foto's kopieren/plakken

[lam201]

Ik heb een excel bestand dat ik gebruik om pdf's te creeren met artikelen en bijbehorende afbeeldingen.
Het gaat hierbij om ca. 200 afbeeldingen per pdf (15 per pagina)

ik gebruik daarvoor de volgdende procedure.
eerst importeer ik alle afbeeldingen (jpg) uit een map op de harde schijf.
Deze sla ik op in een werkblad 'Images' waarbij ik elke afbeelding als naam het artikelnummer geef.

Stap twee is dat ik met een macro (module2.Sub FotosToevoegen()) elke afbeelding op de juiste plek zet in het werkblad 'afdrukpagina'.
Dat doe ik omdat er meerdere pdf's gemaakt moeten worden, elk met een eigen assortiment.

Eerst alle afbeeldingen importeren en dan kopieren/plakken werkt vele malen sneller dan telkens alle afbeeldingen (jpg) te importen vanaf de harde schijf.

Maar hier het probleem.
Soms crasht Excel midden in deze procedure (foto's toevoegen). Sluit af. Boem, pats.
Niks geen waarschuwing of fout code. En omdat het crashmoment willekeurig lijkt, kan ik niet de oorzaak hiervan achterhalen.
Het lijkt er op (maar dat is mijn gevoel) dat de macro te snel is voor windows om een afbeelding te kopieren en te plakken op een andere locatie.


kan iemand de oorzaak an de crash achterhalen?
Of is er wellicht een slimmere manier om te bereiken wat ik wil?


(ik heb in het voorbeeldbestand de werkelijke artikelfoto's vervangen door gekleurde smileys.
ivm privacy en de maximale bestandsgrote van bijlagen op Helpmij.nl)

 

[snb]

Ik denk dat het bestand dan teveel afbeeldingen bevat, wat het werkgeheugen niet aankan.

Doe het simpel zó:

Sub M_snb()
    sn = Sheet2.Cells(6, 3).CurrentRegion
    
    For j = 2 To UBound(sn) Step 2
      For jj = 2 To UBound(sn, 2)
        Sheet3.Shapes(Format(sn(j - 1, jj))).CopyPicture
        Sheet2.Cells(j + 5, jj + 2).PasteSpecial
       Next
    Next
End Sub

 

[lam201]

dank je.
Dit lijkt inderdaad te werken.
Ik ga 't nog uitgebreider testen.

 

[snb]

Voor alle zekerheid kun je nog deze aanvulling gebruiken:

Sub M_snb()
  sn = Sheet2.Cells(6, 3).CurrentRegion
  
  sheet2.shapes.selectall
  selection.delete
  
  For j = 2 To UBound(sn) Step 2
    For jj = 2 To UBound(sn, 2)
      Sheet3.Shapes(Format(sn(j - 1, jj))).CopyPicture
      Sheet2.Cells(j + 5, jj + 2).PasteSpecial
    Next
  Next
End Sub