Buton renginin değişmesi

[ozgurche]

Arkadaşlar merhaba, ekte verdiğim dosyada butonun rengini 10 saniye sonra kırmızıdan yeşile döndürüp ve aynı zamanda buton üzerindeki kelimenin örneğin Ahmet kelimesinin veli olacak şekilde bir makroya ihtiyacım var.
Yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Kod dosyanızın açılışı ile devreye girecektir. 5 saniyede bir nesne rengi değişecektir.

Option Explicit
Dim X As Shape

Sub AUTO_OPEN()
    DoEvents
    Application.Wait Now + TimeValue("00:00:05")
    RENK1
End Sub

Sub RENK1()
    DoEvents
    
    Set X = ActiveSheet.Shapes("1 Dikdörtgen")
    
    With X.DrawingObject
        .ShapeRange.Fill.ForeColor.SchemeColor = 11
        .ShapeRange.Fill.Visible = msoTrue
        .ShapeRange.Fill.Solid
        .Characters.Text = "VELİ"
        .HorizontalAlignment = xlCenter
        With .Characters(Start:=1, Length:=4).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
    End With
    Application.Wait Now + TimeValue("00:00:05")
    RENK2
End Sub

Sub RENK2()
    DoEvents
    
    With X.DrawingObject
        .ShapeRange.Fill.ForeColor.SchemeColor = 10
        .ShapeRange.Fill.Visible = msoTrue
        .ShapeRange.Fill.Solid
        .Characters.Text = "ALİ"
        .HorizontalAlignment = xlCenter
        With .Characters(Start:=1, Length:=3).Font
            .Name = "Calibri"
            .FontStyle = "Normal"
            .Size = 11
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 1
        End With
    End With
    AUTO_OPEN
End Sub

 

[omerceri]

Biraz uğraşmıştım. Aşağıdaki kodu bir modül sayfasına yapıştırın Şeklin üzerinde sağ tıklayın, Makro ata da Test1 seçin. Düğmeye tıklayınca renk ve yazı değişiyor

Sub test1()
    Application.Wait (Now + TimeValue("0:00:05"))
 Dim X As Shape
 Set X = ActiveSheet.Shapes("1 Dikdörtgen")
If X.TextFrame.Characters.Text = "Hüseyin" Then
  X.Fill.ForeColor.SchemeColor = 1
X.TextFrame.Characters.Text = "Hasan"
Else
X.Fill.ForeColor.SchemeColor = 3
X.TextFrame.Characters.Text = "Hüseyin"
End If
End Sub

 

[ozgurche]

Yardımlarınız için çok teşekkür ederim.