Makro Jpg Kaydetme Boş Resim Sorunu

[aras10]

Merhaba arkadaşlar. Excelde bir sayfayı jpg olarak masaüstüne kaydetmek istiyorum. Makro kodum bundan 2 sene önce sorunsuz çalışıyordu tekrar kullanmam gerekti ancak şuan masaüstüne kaydediyor fakat boş bir resim olarak kaydediyor nerede hata olduğunu bulamadım. Excel 2016 kullanıyorum Windows 10 kurulu

Örnek dosya

ornek.xlsm dosyasını indir - download

ornek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Makro kodları

Sub foto()
Dim obce As Object
Dim caart As Chart
Dim jipeg As Range
masaustu = CreateObject("WScript.Shell").specialfolders("Desktop")
ad = "test"
For x = 1 To 20000
    If Dir(masaustu & "\" & "ad" & x & ".jpg") = "" Then
        yol = masaustu & "\" & "ad" & x & ".jpg"
        Exit For
    End If
Next
Application.ScreenUpdating = False
Set jipeg = ActiveSheet.Range("A1:U23")
jipeg.Copy
Set obce = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
obce.Select
ActiveSheet.Paste
obce.Delete
With Selection
.CopyPicture 1, 2
Set caart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
Range("a1").Select
With caart
.Paste
.Export yol 'nereye çıkartılacaksa
.Parent.Delete
End With
.Delete
End With
Set jipeg = Nothing
Set obce = Nothing
End Sub

 

[Muzaffer Ali]

Merhaba
Kodları çalıştırdım.
Sorun yok çalışıyor.
Belirtilen alanı fotoğraf olarak masa üstüne kaydediyor.

 

[aras10]

Benim bilgisayarımda masaüstüne kayıt ediyor ancak resim boş şekilde kayıt ediyor sebebi ne olabilir? Excel lisanslı değil bundan kaynaklı olabilir mi eskiden bendede sorunsuz bir şekilde çalışıyordu. Windows 10 mu kullanıyorsunuz? Bende windows 10 yüklü ve excel 2016 mevcut

 

[Muzaffer Ali]

Win 10, Office 2013 var.

Dosyanızı ekleyin inceleyelim. Belki başka bir sorun vardır.

 

[Korhan Ayhan]

Benzer bir konuyu daha önce cevaplamıştık diye hatırlıyorum. Arama yaptığımda aşağıdaki konuya ulaştım. İnceleyin belki sizin içinde çözüm olabilir.

windows 10 ofis 2016 makrolar çalışmıyor

merhaba arkadaşlar; windows 7 ve ofis 2003 de çalışan makro windows 10 ofis 2016 makrolar çalışmıyor. yardımlarınızı rica ediyorum. makro aşağıdaki gibidir. Sub resimekle() On Error Resume Next Set s1 = Sheets("Sayfa2") Selection.CopyPicture xlScreen, xlBitmap ActiveSheet.Paste genislik =...

www.excel.web.tr