Qual propriedade chama o nome do componente numa caixa de diálogo?

[WBastos]

Olá pessoal!
Estou exercitando um pouco as caixas de diálogos e me deparei com um desafio aqui:

Como faço para obter o nome de um objeto através de uma varredura dentro de uma caixa de diálogo?

• Pensei que fosse o TypeName (Variavel), mas ela me retorna o tipo de objeto (Object);

• Queria varrer pelo nome do objeto (“CommandButton” ou outro objeto qualquer);

Ao invés de:

For Each bt In oDlgBotao.Controls
If TypeName ( bt ) = “Object” Then

Eu queria:

For Each bt In oDlgBotao.Controls
If TypeName ( bt ) = “CommandButton” Then

Vídeo da aula em VBA
cor-botoes.ods (11.1 KB)

Option Explicit

Public oDlgBotao As Object
Public bt As Object
Public btn1 As Object
Public btn2 As Object
Public btn3 As Object
Public btn4 As Object
Public lbl1 As Object

Sub CorBotao
DialogLibraries.LoadLibrary ( “Standard” )
oDlgBotao = CreateUnoDialog ( DialogLibraries.Standard.getByName ( “frmBotoes” ))

btn1 = oDlgBotao.getControl ( “CommandButton1” )
btn2 = oDlgBotao.getControl ( “CommandButton2” )
btn3 = oDlgBotao.getControl ( “CommandButton3” )
btn4 = oDlgBotao.getControl ( “CommandButton4” )
lbl1 = oDlgBotao.getControl ( “Label1” )

End Sub

Sub AbrirFrmBotoes
Call CorBotao
oDlgBotao.execute ()
oDlgBotao.Dispose ()
End Sub

Sub CarregarCores ( bt As CommandButton )
bt.Model.BackgroundColor = RGB ( 56 , 0 , 100 )
bt.Model.TextColor = RGB ( 0 , 255 , 0 )
End Sub

Sub CorBtn1
Call CarregarCores ( btn1 )
btn1.model.label = “OK”
End Sub

Sub CorBtn2
Call CarregarCores ( btn2 )
btn2.model.label = “OK”
End Sub

Sub CorBtn3
Call CarregarCores ( btn3 )
btn3.model.label = “OK”
End Sub

Sub CorBtn4
Call CarregarCores ( btn4 )
btn4.model.label = “OK”
End Sub

Sub CorLbl1
Call CarregarCores ( lbl1 )
lbl1.model.label = TypeName ( lbl1 )
End Sub

Sub frmMouseMove
For Each bt In oDlgBotao.Controls
If TypeName ( bt ) = “Object” Then
bt.Model.BackgroundColor = RGB ( 200 , 200 , 200 )
bt.Model.TextColor = RGB ( 10 , 10 , 10 )
bt.Model.Label = “Não OK”
End If

Next
End Sub

[WBastos]

Encontrei uma solução temporária aqui:

Sub frmMouseMove
For Each bt In oDlgBotao.Controls
If bt.ImplementationName = “stardiv.Toolkit.UnoButtonControl” Then
'msgbox bt.ImplementationName
bt.Model.BackgroundColor = RGB ( 200 , 200 , 200 )
bt.Model.TextColor = RGB ( 10 , 10 , 10 )
bt.Model.Label = “frmMouseMove”
bt.visible = 1
End If
Next
End Sub