Error bij kopiëren en plakken afbeeldingen in een vba script

[heidekabouter]

Ik heb een vba script waarbij ik en afbeelding van mijn pc selecteer en die op 2 tabbladen van een excel document plak. Het moet geen link zijn naar de locatie op mijn pc, maar embed in het document.
Als ik het uitvoer krijg ik een error op ws.Range("B3").PasteSpecial maar als ik foutopsporing doe en het script verder laat lopen, komt de error niet terug.
het script:

Sub AddPictureToCellB3()
Dim imagePath As Variant
Dim pictureTop As Double
Dim pictureLeft As Double
Dim ws As Worksheet
Dim pic As Picture

' Open the file dialog to select an image
With Application.fileDialog(msoFileDialogFilePicker)
.Title = "Select an Image"
.Filters.Clear
.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.gif"
.AllowMultiSelect = False

If .Show = -1 Then
' Get the selected image path
imagePath = .SelectedItems(1)

' Set the top and left positions of the picture relative to cell B3
pictureTop = Range("B3").Top
pictureLeft = Range("B3").Left

' Add the picture to the active worksheet
Set ws = ActiveSheet
Set pic = ws.Pictures.Insert(imagePath)

' Resize and position the picture
With pic
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = Range("B3").Height
.ShapeRange.Width = Range("B3").Width
.Top = pictureTop
.Left = pictureLeft
End With

' Save the picture as an embedded image in the active worksheet
pic.Select
Selection.Copy
ws.Range("B3").PasteSpecial

' Clean up
Application.CutCopyMode = False
pic.Delete

' Add the picture to the "Planning" worksheet
Sheets("Planning").Activate
Set ws = ActiveSheet
Set pic = ws.Pictures.Insert(imagePath)

' Resize and position the picture on the "Planning" worksheet
With pic
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = Range("B3").Height
.ShapeRange.Width = Range("B3").Width
.Top = pictureTop
.Left = pictureLeft
End With

' Save the picture as an embedded image on the "Planning" worksheet
pic.Select
Selection.Copy
ws.Range("B3").PasteSpecial

' Clean up
Application.CutCopyMode = False
pic.Delete


End If
End With
Sheets("Inventarisatie").Activate
End Sub

De foutmelding:
Fout 1004 tijdens uitvoeren
Methode PasteSpecial van klasse range is mislukt

Iemand een idee hoe dit op te lossen?

 

[mvdvlist]

Graag dit script ordelijk tussen de code tags plaatsen. En het beste het hele document...(Desnoods "uitgekleed") plaatsen. Niemand gaat dit overtypen om te testen...

 

[AHulpje]

Een Exceldocument is inderdaad handiger, ik heb de code gewoon gekopiëerd. Maar dan wel even twee werkbladen toevoegen met de juiste benaming.
Bij mij werkt de macro prima zonder foutmelding, als plaatje heb ik een willekeurig jpg-tje gebruikt.

 

[heidekabouter]

Graag dit script ordelijk tussen de code tags plaatsen. En het beste het hele document...(Desnoods "uitgekleed") plaatsen. Niemand gaat dit overtypen om te testen...

Excuses van mijn kant, was inderdaad wel beter geweest, beginnersfoutje

 

[heidekabouter]

Een Exceldocument is inderdaad handiger, ik heb de code gewoon gekopiëerd. Maar dan wel even twee werkbladen toevoegen met de juiste benaming.
Bij mij werkt de macro prima zonder foutmelding, als plaatje heb ik een willekeurig jpg-tje gebruikt.

Ik had dus ook verwacht dat het zonder problemen zou werken. Nu maak ik een uitgekleed excel document om hier te posten en het werk inderdaad zoals bedoel zonder foutmeldingen. Ik snap het niet. Ook het origineel werkt nu goed terwijl het de afgelopen dagen en zelfs vanmiddag steeds niet werkte.

Bedankt voor de moeite! En nogmaals excuus voor de beroerde manier van posten.

 

[snb]

Stop het overbodig citeren/quoten. Gebruik de juiste reageerknop !

 

[OctaFish]

En zet alsnog je code tussen code tags!