• DİKKAT

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

tüm nesneleri tek koda bağlamak

Katılım
10 Mayıs 2009
Mesajlar
1,080
Excel Vers. ve Dili
2003 türkçe
Herkese merhabalar;

Sayfa üzerinde 80 civari Label'im var.Öyle bir kod lazım ki hangi label'a basarsam basayım UserForm1 açılsın ve form üzerindeki Label1'in Caption'ı tıklanmış olanınkiyle aynı olsun..

Yardımcı olacak olanlara şimdiden teşekkür ederim.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
ClassModüle:
Kod:
Public WithEvents lbl As msforms.Label
Private Sub lbl_Click()
    UserForm1.Label1.Caption = lbl.Caption
    UserForm1.Show
End Sub

Auto_Open'a
Kod:
Dim lbl() As New Class1
Sub Auto_Open()
Dim say As Integer, tip As String, a As Integer
say = ActiveSheet.Shapes.Count
For a = 1 To say
    tip = TypeName(ActiveSheet.Shapes(a).OLEFormat.Object.Object)
    If tip = "Label" Then
        c = c + 1
        ReDim Preserve lbl(c)
        Set lbl(c).lbl = ActiveSheet.Shapes(a).OLEFormat.Object.Object
    End If
Next
End Sub
 

Ekli dosyalar

Evren Hocam harikasınız böyle her bir click olayına tek tek yazmaktan çok daha şık oldu ellerinize sağlık..
 
Hocam önemli bir sorun var..Labelların yanı sıra sayfa1 de bir tane de dosyadan eklenmiş resim var.Sanırım o sorun yaratıyor.
Şu satırı işaretliyor
tip = TypeName(ActiveSheet.Shapes(a).OLEFormat.Object.Object)

ve Object doesn't this property or method şeklinde debug veriyor.
 
Hocam önemli bir sorun var..Labelların yanı sıra sayfa1 de bir tane de dosyadan eklenmiş resim var.Sanırım o sorun yaratıyor.
Şu satırı işaretliyor
tip = TypeName(ActiveSheet.Shapes(a).OLEFormat.Object.Object)

ve Object doesn't this property or method şeklinde debug veriyor.

:cool:
Kod:
Dim say As Integer, tip As String, a As Integer
On Error Resume Next
 
Bu kadar zaman sitede bir sürü şey öğren şunu bir akıl etme..Gel de utanma şimdi:)

Çok sağolun hocam dosyaya yerleştirdim gayet güzel çalışıyor.Tekrar ellerinize sağlık.
 
Bu kadar zaman sitede bir sürü şey öğren şunu bir akıl etme..Gel de utanma şimdi:)

Çok sağolun hocam dosyaya yerleştirdim gayet güzel çalışıyor.Tekrar ellerinize sağlık.
Rica ederim.
İyi çalışmalar.:cool:
 
Geri
Üst