Otomatik Şekile Makro ile etiket ekleme

[peker]

Otomatik Şekile Makro ile etiket ekleme imkanımız varmı? Rengini boyutunu degiştirebiliyoruz ama etiket ekleme yapamıyorum. mumkunmudur..

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodlar, aktif olan sayfaya önce 16 köşeli bir yıldız ekler. Sonra yıldızın içine bir etiket ekler ve biçimlendirir.

Shape'e etiket ekleme kırmızı ile işaretlenmiştir.

Sub OtomatikSekil_Ekle()
Dim sp As Shape
Dim sh As Worksheet
Set sh = Sheets("Sayfa1")
On Error Resume Next
sh.Shapes("DenemeShape").Delete
Set sp = sh.Shapes.AddShape(msoShape16pointStar, 1, 1, 100#, 100#)
With sp
    .Name = "DenemeShape"
    With .TextFrame.Characters
[COLOR=red]         .Text = "Etiket budur"[/COLOR]
         With .Font
              .Name = "Arial"
              .Size = 14
              .Bold = True
          End With
    End With
End With
Set sp = Nothing
Set sh = Nothing
End Sub

 

[peker]

tesekkurler

Cok Tesekkur Ederim. Saygilar