afbeelding meekopieren via VBA

[knabbie]

Ik heb via de sites van ron de bruin en wim gilles een mail routine in elkaar geflanst,die een deel van het werkblad kopieert naar een andere map opslaat en daarna mailt,
de kopie word niet verwijderd.

Ik zit nog met een klein probleempje, op het origineel is een afbeelding ingevoegd die ik niet meegekopieerd krijg naar de kopie.

Heeft iemand een idee?

Dim Source As Range
    Dim Dest As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long

    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("b2:f59").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb = ActiveWorkbook
    Set Dest = Workbooks.Add(xlWBATWorksheet)

    Source.Copy
    With Dest.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        
    End With
    Range("e4") = "KOPIE"
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayZeros = False

De afbeelding moet komen op de cel e2 tot e6 in de kopie

 

[Wigi]

IHeeft iemand een idee?

Doe eens een voorbeeldfile erbij met enkel de afbeelding of zo.

 

[knabbie]

voorbeeldbestandje

Voorbeeldbestandje Bekijk bijlage Mail-TEST-afb-.xls

 

[knabbie]

voor wigi

Wigi

Voor het geval je aan het zoeken bent naar het meekopieeren van afbeeldingen,

het rode stukje code heb ik vervangen door het blauwe stukje code en de hele range word gekopieerd maar dan slechts als picture,wat eigenlijk niet de bedoeling is.

Source.Copy
    
    With Dest.Sheets(1)
    [COLOR="Blue"].Pictures.Paste [/COLOR]    
       [COLOR="Red"] '.Cells(1).PasteSpecial Paste:=8
        '.Cells(1).PasteSpecial Paste:=xlPasteValues
        '.Cells(1).PasteSpecial Paste:=xlPasteFormats
        ''.Cells(1).PasteSpecial 'Paste:=("Picture 38")
        ''Worksheets("Sheet1").Paste Destination:=Worksheets("Sheet1").Range("E2")
      '' .PasteSpecial Destination:=Worksheets("Sheet1").Range("E2")
       .Cells(1).Select[/COLOR]        
        Application.CutCopyMode = False
  
    End With