Excele yapıştırılmış resimleri çekip almak

[harpesiri]

merhabalar,
excell sayfasına yerleştirilmiş resimleri farklı kaydetmek istiyorum.kopyalayıp paint kullanarak yapıyorum ama bu çok zaman alıyor.bu şekilde yaklaşık 5000'e yakın resim var. bu konuda bilgisi olan yardım ederse sevinirim.
iyi çalışmalar..

 

[Ferhat Pazarçevirdi]

Aşağıdaki makroyu çalıştırınız.

Size, hangi dizine kaydetmek istediğiniz soracak. Resimleri kopyalamak istediğiniz dizini seçip, "Tamam" deyin.

NOT : Sadece, sayfa üzerindeki Picture nesnelerini dosya olarak dışarı atar.

Option Explicit
Sub Sayfadaki_Resimleri_Disari_Aktar()
    Dim oRsm As Shape
    Dim oGrf As ChartObject
    Dim sDzn As String
    Dim oKls As Object
    
    Set oKls = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
    
    If oKls Is Nothing Then
           MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
           Set oKls = Nothing
           Exit Sub
    Else
           sDzn = oKls.self.Path
    End If
    
    For Each oRsm In ActiveSheet.Shapes
        
        If oRsm.Type = msoPicture Then
            oRsm.Copy
            Set oGrf = ActiveSheet.ChartObjects.Add(0, 0, oRsm.Width, oRsm.Height)
            
            With oGrf
                With .Chart
                    .Paste
                    .Export sDzn & Application.PathSeparator & oRsm.Name & ".jpg"
                End With
                
                .Delete
            End With
        
        End If
    
    Next
    
    Set oKls = Nothing
    
End Sub

 

[Halit TÜRK]

Merhabalar

Excel değilde word sayfasında kodlarda nasıl değişiklik yapılmalıdır.. İyi Çalışmalar dilerim..