Macro'yla Excel'e İçinde Yazı Bulunan Şekil Eklenmesi
Public Sub SekilEkle()
'100 nokta sağa, 50 nokta aşağıya 120 nokta genişliğinde 160 nokta yüksekliğinde dikdörtgen oluşturulması
ActiveSheet.Shapes.AddShape msoShapeRectangle, 100, 50, 120, 160
'Dikdörtgenin içinin yeşil renkli yapılması
ActiveSheet.Shapes.AddShape msoShapeRectangle, 100, 50, 120, 160
'Dikdörtgenin içinin yeşil renkli yapılması
ActiveSheet.Shapes(1).Fill.ForeColor.RGB = vbGreen
'Yazı renginin siyah yapılması
ActiveSheet.Shapes(1).TextFrame.Characters.Font.ColorIndex = 1
ActiveSheet.Shapes(1).TextFrame.Characters.Font.ColorIndex = 1
'Son satir numarasının bulunması
SonSatir = Cells(Rows.Count, "A").End(xlUp).Row
SonSatir = Cells(Rows.Count, "A").End(xlUp).Row
Satir = "" 'Dikdörtgenin içinin satır yazısı değişkeninin temizlenmesi
'Birinci satırdan son satıra kadar
For r = 1 To SonSatir
For r = 1 To SonSatir
'Dikdörtgenin içindeki satır yazısının oluşturulması
Satir = Satir & ActiveSheet.Cells(r, 1) & Chr(13)
Satir = Satir & ActiveSheet.Cells(r, 1) & Chr(13)
'Satır yazısının dikdörtgen içindeki metin kısmına atanması
ActiveSheet.Shapes(1).TextFrame.Characters.Text = Satir
If r = 1 Then 'Birinci satırsa
Baslik = ActiveSheet.Cells(r, 1) 'Başlık yazısının uzunluk hesabı için elde edilmesi
ActiveSheet.Shapes(1).TextFrame.Characters.Text = Satir
If r = 1 Then 'Birinci satırsa
Baslik = ActiveSheet.Cells(r, 1) 'Başlık yazısının uzunluk hesabı için elde edilmesi
'Birinci karakterden Başlık yazısının uzunluğu kadar karakterin Bold yapılması
ActiveSheet.Shapes(1).TextFrame.Characters(1, Len(Baslik)).Font.Bold = True
Else
'Değilse Başlık yazısının uzunluğundan geri kalanının Bold olmamasının sağlanması
Else
'Değilse Başlık yazısının uzunluğundan geri kalanının Bold olmamasının sağlanması
ActiveSheet.Shapes(1).TextFrame.Characters(Len(Baslik), Len(Satir) - Len(Baslik)).Font.Bold = False
End If
End If
Next r 'Döngünün ilk satırına dönülmesi
End Sub
'------------------------------------------------------------------------------------------------------------------------
Prosedür