• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Şekil'e makro atamak

M

mehmet dur

Katılım
27 Mart 2021
Mesajlar
102
Excel Vers. ve Dili
ofis 2010
Merhaba
Sayfa üzerine kare dikdörtgen vs. şekiller ekledim. Bu şekillerin üzerine tıklayınca userform açılsın ve form üzerindeki textbox içerisine şeklin adını yazmasını istiyorum.
Yardımlarınız için şimdiden teşekkür ederim.
 
Her şeklinize aşağıdaki makroyu bağlayarak dener misiniz.

Kod: 
Sub SekilTiklandi()

    Dim sekilAdi As String
    Dim shp As Shape
    Dim turkceAd As String

    On Error GoTo Hata

    sekilAdi = CStr(Application.Caller)
    Set shp = ActiveSheet.Shapes(sekilAdi)

    Select Case shp.AutoShapeType

        Case msoShapeRectangle
            turkceAd = "Dikdörtgen"

        Case msoShapeRoundedRectangle
            turkceAd = "Yuvarlatılmış Dikdörtgen"

        Case msoShapeOval
            turkceAd = "Oval / Daire"

        Case msoShapeIsoscelesTriangle
            turkceAd = "Üçgen"

        Case msoShapeRightTriangle
            turkceAd = "Dik Üçgen"

        Case msoShapeDiamond
            turkceAd = "Baklava Dilimi"

        Case msoShapeParallelogram
            turkceAd = "Paralelkenar"

        Case msoShapeTrapezoid
            turkceAd = "Yamuk"

        Case msoShapeHexagon
            turkceAd = "Altıgen"

        Case msoShapePentagon
            turkceAd = "Beşgen"

        Case Else
            turkceAd = shp.Name

    End Select

    UserForm1.TextBox1.Value = turkceAd

    UserForm1.Show

    Exit Sub

Hata:
    MsgBox "Bu makro doğrudan çalıştırılamaz." & vbCrLf & _
           "Lütfen şekle sağ tıklayıp Makro Ata > SekilTiklandi seçin.", _
           vbExclamation, "Hata"

End Sub
 
Ali Bey cevabınız için çok teşekkür ederim
Telefondan yazdığım için biraz uzun sürdü.
Kodları yazdım ve şekillere atadım. Yalnız bazılarında çalıştı , gruplandırdığım şekillerde çalışmadı.
 
Bu arada çok sayıda şekil var ve ben isimlerini değiştirdim. Kendi yazdığım isimlerin çıkmasını istiyorum.
 
Aşağıdaki kodları dener misin.

Kod: 
Sub SekilTiklandi()
    Dim sekilAdi As Variant
    Dim shp As Shape
    Dim gorunurIsim As String
    
    On Error Resume Next

    sekilAdi = Application.Caller
    Set shp = ActiveSheet.Shapes(sekilAdi)

    If Not shp Is Nothing Then
        
        Dim parentShp As Shape
        Set parentShp = Nothing
        Set parentShp = shp.ParentGroup

        If Not parentShp Is Nothing Then
          
            gorunurIsim = parentShp.Name
        Else
          
            gorunurIsim = shp.Name
        End If
    Else
        gorunurIsim = "Tanımsız Nesne"
    End If

 
    UserForm1.TextBox1.Value = gorunurIsim
    UserForm1.Show

    On Error GoTo 0
End Sub
 
Ali Bey bu kodlarda da aynı oluyor.
Bazılarını doğru okuyor bazılarına tanımsız nesne diyor.
 
mehmet dur' Alıntı:
Ali Bey bu kodlarda da aynı oluyor.
Bazılarını doğru okuyor bazılarına tanımsız nesne diyor.
Genişletmek için tıkla ...
Sub UserfomuAc
UserForm1.Show
End Sub

Bu kodu modulun birine yazın. Daha sonra sekillere gelip sag tiklayip makro ata deyin bu makroyu seçin. Her şekil icin bunu yapiniz.
 
Sayın Ali Bey ve sayın volki_112 bey cevaplarını denedim ama yine olmadı. Lütfen yardım eder misiniz.
 
Mehmet Bey,

Sorunuzu doğru anladıysam Ali Bey'in ilk ve sonraki verdiği kod için yaptığım kontrol sonucu sonuçların hepsi doğru gelmekte..
Vokan Bey'in vermiş olduğu kod sadece userformu ekrana çağırır içine herhangi bir bilgi getirmez.

Gerekli olanlar;

1- Mobil bir uygulama kullanıyorsanız belirtin, masaüstü bir bilgisayarda denemeler yapıyorum.
2- **** Dosyanızda bir userform eklemiş olmalısınız adı UserForm1, ve bu formun üzerinde 1 adet metin kutusu eklemelisiniz bununda adı TextBox1 olmalı.
1778089575743.png
3- Eklemiş olduğunuz şekil/nesneler için otomatik ad tanımlaması yapılıyor, yuvarlak gördüğünde yuvarlak dememesi içi şekil/nesne yi seçtikten sonra sol üstte adres kutusunda beliren ismi değiştiriniz. Örneğin, yuvarlak yerine bu şekil seçildiğinde Elma yazdırılabilir.
1778088846538.png
4- Her şekil/nesne için tek tek aynı makro için atama yapmanız gerekir gruplandırılmış nesnelerde grup ismi belirir. Örneğin 10 tane şekilden 3 ünde tıklandığında aynı isim çıksın istiyorsanız, burada nesnelere aynı ismi veremeyeceğiniz için CTRL tuşuna basarak seçim yapıp gruplandırmayı sağ tuş ile yapınız ve buraya bir isim veriniz. (*Dosanızın düzenine bağlı verimli olmayabilir)

5- Halen olmadığını düşünüyorsanız,sorunun kaynağını tespit etmek için örnek dosya paylaşın, harici bir siteye yükleyip link paylaşabilirsiniz.

İyi çalışmalar.
 
Merhaba
Uygulama masaüstü nde ben telefondan yazıyorum. Özel sektörde çalıştığım için bilgisayar kısıtlı. Dosya gönderip alamıyorum.
Sizinde söylediğiniz gibi uygulamada form ve textbox ekli, şeklin isminide aynı yerden değiştirdim. Ama tek şekil olanlarının da grup olanlarınında bazılarını okumuyor.
Yalnız ben isimlerini değiştirirken gösterdiğiniz ad değiştirme yerinden, bazılarının (ismi uzun olan) değişmediği için Biçim bölümdeki, seçim sekmesinden yan tarafta açılan bölümden değiştirdim.
Acaba ondan kaynaklanabilir mi.
 
Ne kadar bir uzunluktan bahsediyorsunuz? *Nesne isimleri Maksimum 255 karakter destekliyor diye hatırlıyorum (Yanılıyor da olabilirim).

Nesne/Şeklin ismini farklı yerlerden değiştirmek mümkün, sonuç olarak nesneye tıkladığınızda benim tarif ettiğim alanda atamış olduğunuz ismi görüyor olmanız değişikliği yaptığınız anlamına gelir.

Dilerseniz yeni 2 şekil ekleyip birini dediğiniz gibi adlandırın diğerini benim dediğim gibi. pek farklılık olacağını sanmıyorum ama *uzunluk için net birşey söyleyemiyorum, zira üst sürüm bir office kullandığımdan farklılık gösterebilir.
 
**Ayrıca sayfada yer alan nesnelerin isimlerini toplu olarak görmek için Giriş sekmesinde > Bul ve Seç > Seçim bölmesi yolu ile açılan alandan inceleyebilirsiniz.
1778091952121.png

1778091935038.png
 
Ofis 2010 kullanıyorum, uzun olanların karakter sayısı Max. 50 dir. Tarif ettiğiniz alanda değiştirdiğim isimler görünüyor.
Okunmayan şekiller Ali bey'in verdiği ikinci kod da
İf not parentshp ıs nothing then satırından sonra sona gidiyor
1. Modda ise
Set SHP = activesheet. Shaped (sekiladı)
Bu koddan sonra en sona gidiyor.
 
Arkadaşlar kusura bakmayın sanırım sorunu buldum.
Birleştirdiğim bütün nesnelerin isimlerini Seçim bölmesi kısmından aynı isimde olacak şekilde değiştirdim. Şimdilik çalışıyor. Belki sizlerde aynı uyarıyı söylemişsinizdir ama ben anlamadım. Kusura bakmayın hakkınızı helal edin.
Hayırlı akşamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst