DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
İlettiğiniz linkte bir kod bulup kendi çalışmama uygulamaya çalıştım
Sub RESİM()
Dim oCht As Chart
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("D:\resim")
dosya = f.Files.Count + 1
Worksheets("HAZIRLIK").Range("A94:CB132").CopyPicture Screen, Picture
Set oCht = Charts.Add
With oCht
.Paste
.Export Filename:="D:\resim\" & dosya & ".jpg", Filtername:="JPG"
End With
For i = 1 To Sheets.Count
If Sheets(i).Name <> "HAZIRLIK" Then
Sheets(i).Delete
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Merhabalar. Verdiğiniz link açılmıyor. Başka şekilde yardımcı olabilir misiniz?
İlgilendiğiniz için teşekkürler makrodan hiç anlamıyorum. Ancak sanırım siz dosyanızda resimler klasörünü var sayılan yol olarak belirlemişsiniz bende değiştirmedim. Bu haliyle butona tıkladığımda hata veriyor. (Ret = OleCreatePictureIndirect(tPICTDEST, tIID, 1, IPic)Merhabalar,
Dener misiniz?
Koddaki yolu kendi bilgisayarınıza göre ayarlayın..Ayrıca excel sayfadaki bölümü de ayarlayın
İlgilendiğiniz için teşekkürler. Ancak aynı hatayı veriyor bende. Office 2019 Türkçe kullanıyorum. Sorun dil den mi kaynaklanıyor acaba?Ekteki dosyayı indirin, masa üstüne alın ve Rar dan çıkarın. Ben dosyanın içine Resimler1 adında klasör ekledim. Ama buna gerek yok. Butona tıkladığınızda masa üstüne Resimler1 adında klasörü açacak ve B2 ile G17 arasının resmini buraya kaydedecektir.
Ayrıca daha önce gönderdiğim dosya bende çalışıyor (Office 2010 Eng 32 Bit)