- Katılım
- 16 Temmuz 2006
- Mesajlar
- 188
- Excel Vers. ve Dili
- xp profesional 2002
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 = Selection.Width
yukseklik = Selection.Height
Selection.Cut
MkDir "c:\aa\"
Set grafik = s1.ChartObjects.Add(Left:=s1.[a1].Left, Top:=s1.[a1].Top, Width:=genislik, Height:=yukseklik)
grafik.Chart.Paste
grafik.Chart.Export "c:\aa\xresimx.gif"
grafik.Delete
sat = WorksheetFunction.CountA(Sheets("Sayfa2").[a:a]) + 1
s1.Range("a" & sat) = "."
Set ekle = s1.Range("a" & sat).AddComment
ekle.Text Text:=""
With ekle.Shape
.Fill.UserPicture "c:\aa\xresimx.gif"
.Width = genislik
.Height = yukseklik
End With
Kill "c:\aa\xresimx.gif"
RmDir "C:\aa\"
MsgBox "Açıklama oluşturulmuştur"
End Sub
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 = Selection.Width
yukseklik = Selection.Height
Selection.Cut
MkDir "c:\aa\"
Set grafik = s1.ChartObjects.Add(Left:=s1.[a1].Left, Top:=s1.[a1].Top, Width:=genislik, Height:=yukseklik)
grafik.Chart.Paste
grafik.Chart.Export "c:\aa\xresimx.gif"
grafik.Delete
sat = WorksheetFunction.CountA(Sheets("Sayfa2").[a:a]) + 1
s1.Range("a" & sat) = "."
Set ekle = s1.Range("a" & sat).AddComment
ekle.Text Text:=""
With ekle.Shape
.Fill.UserPicture "c:\aa\xresimx.gif"
.Width = genislik
.Height = yukseklik
End With
Kill "c:\aa\xresimx.gif"
RmDir "C:\aa\"
MsgBox "Açıklama oluşturulmuştur"
End Sub