sıralı kayıt

[acarselcuk1]

merhaba arkadaşlar. sayın leventm bey in bana hazırladığı aşagıdaki makroda sürekli sayfa 2 a1 hücresine kayıt yapıyor. bunu sıralayabilirmiyiz. a sütunundaki boş satıra sırasıyla yapabilirmi ? teşekkürler.. (tabi bu arada sayın leventm beyden o zamanki isteğim bu şekildeydi. ismini teşekkür babında yazdım


Sub resimekle()
On Error Resume Next
Set s1 = Sheets("Sayfa2")
Selection.CopyPicture xlScreen, xlBitmap
ActiveSheet.Paste
genislik = Selection.Width
yukseklik = Selection.Height
Selection.Cut
Set grafik = s1.ChartObjects.Add(Left:=s1.[a1].Left, Top:=s1.[a1].Top, Width:=genislik, Height:=yukseklik)
grafik.Chart.Paste
grafik.Chart.Export "c:\xresimx.gif"
grafik.Delete
s1.[a1].ClearComments
Set ekle = s1.[a1].AddComment
ekle.Text Text:=""
With ekle.Shape
.Fill.UserPicture "c:\xresimx.gif"
.Width = genislik
.Height = yukseklik
End With
Kill "c:\xresimx.gif"
MsgBox "Açıklama oluşturulmuştur"
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub resimekle()
On Error Resume Next
Set s1 = Sheets("Sayfa2")
Selection.CopyPicture xlScreen, xlBitmap
ActiveSheet.Paste
genislik = Selection.Width
yukseklik = Selection.Height
Selection.Cut
Set grafik = s1.ChartObjects.Add(Left:=s1.[a1].Left, Top:=s1.[a1].Top, Width:=genislik, Height:=yukseklik)
grafik.Chart.Paste
grafik.Chart.Export "c:\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:\xresimx.gif"
.Width = genislik
.Height = yukseklik
End With
Kill "c:\xresimx.gif"
MsgBox "Açıklama oluşturulmuştur"
End Sub

 

[acarselcuk1]

üsteki makroyu girdim fakat a12 ye kayıt yapıyor. ikinci de a12 de yineliyor.
ben sırasıyla makro çalıştırdıkça açıklamayı a1-a2-a3 sırasıyla kaydetmesini istiyorum. ilginize teşekkürler...

 

[Levent Menteşoğlu]

Yukarıdaki kodu yeniledim tekrar deneyin.

 

[acarselcuk1]

sayın leventm ; çok teşekkür ederim.