1
hello
would like to make a For Each In . Shapes "those shapes" but they grouped
I was able to assemble with them disaggregated, but grouped it seems that the procedures are different
what I’ve achieved so far is a little incomplete
Sub SelecFORMA()
Dim Nn As Long, Cj As Long, dsL As Long, dsC As Long, V As Long
Dim Sh As Shape 'Object
Dim ConfigB() As String ' matriz de configuração
Dim CfB(1 To 20) As Long ' define possição das configurações
CfB(1) = 0 'Tipo= 0 controle, 1 chekcbox ,2 option, 3 rotativo
CfB(2) = 1 'Estado= 0 desativado, 1 ativado, possição no rotativo
CfB(3) = 2 'valor se desaAtivado
CfB(4) = 3 'valor se ativado
CfB(5) = 4
CfB(6) = 5 'Linha inicial ( 0 PARA POSSIÇÃO TopLeftCell)****
CfB(7) = 6 'deslocamento LINHA
CfB(8) = 7 'deslocamento LINHA DE GRUPO
CfB(9) = 8 'coluna inicial ( 0 PARA POSSIÇÃO TopLeftCell)****
CfB(10) = 9 'deslocamento COLUNA
CfB(11) = 10 'deslocamento COLUNA DE GRUPO
CfB(12) = 11 '
CfB(13) = 12 '
CfB(14) = 13 '
CfB(15) = 14 'cor fundo se desativado
CfB(16) = 15 'cor fundo se ativado
CfB(17) = 16 'cor texto se desativado
CfB(18) = 17 'cor texto se ativado
CfB(19) = 18 'possição de sequencia acionamento
CfB(20) = 19 'Nome botão
'ActiveSheet.Shapes.SelectAll
Set Sh = ActiveSheet.Shapes(Application.Caller)
'Sh.Fill.BackColor.RGB = RGB(0, 128, 64)
ccs = Sh.TopLeftCell.Column
cs = Cells(1, ccs).Value2
NWP = Sh.OnAction & cs
Gn = Sh.Title ' nome grupo
pre = Sh.OLEFormat.Object.Caption & ccs
ConfigB = Split(Sh.AlternativeText, ",")
If UBound(ConfigB) < 1 Then Exit Sub
If ConfigB(CfB(1)) = "0" Then
V = ConfigB(CfB(2))
If V = 1 Then
ConfigB(CfB(2)) = 0
Sh.BackgroundStyle = 3
Sh.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground2
Else
ConfigB(CfB(2)) = 1
Sh.BackgroundStyle = 1:
Sh.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText2
End If
Sh.AlternativeText = Join(ConfigB, ",")
For Each Sh2 In ActiveSheet.Shapes
ccs = Sh2.TopLeftCell.Column
gcs = Cells(1, ccs).Value2
BBN = Sh2.OnAction & gcs
If BBN = NWP Then
If Gn = Sh2.Title Then
ConfigB2 = Split(Sh2.AlternativeText, ",")
If UBound(ConfigB2) < 19 Then Exit Sub
If ConfigB2(CfB(1)) <> "0" Then
ConfigB2(CfB(1)) = Val(ConfigB(CfB(2))) + 1
End If
Sh2.AlternativeText = Join(ConfigB2, ",")
End If
End If
Next Sh2
Else
'==========================================================
With ActiveSheet
For Each Sh In .Shapes
adf = Sh.TopLeftCell.Address 'Local
ccs = Range(adf).Column
lls = Range(adf).Row
gcs = Cells(1, ccs).Value2
BBN = Sh.OnAction & gcs
If BBN = NWP Then
If Gn = Sh.Title Then ' nome grupo
ConfigB = Split(Sh.AlternativeText, ",")
If UBound(ConfigB) < 10 Then Exit Sub
If ConfigB(CfB(1)) <> "0" Then 'verifica se não é botão de controle
If ConfigB(CfB(6)) = "0" Then dsL = gcs + ConfigB(CfB(7)) + Val(ConfigB(CfB(8))) Else dsL = Val(ConfigB(CfB(6))) + ConfigB(CfB(7)) + Val(ConfigB(CfB(8))) 'LINHA DE SAIDA
If ConfigB(CfB(9)) = "0" Then dsC = gcs + ConfigB(CfB(10)) + Val(ConfigB(CfB(11))) Else dsC = Val(ConfigB(CfB(9))) + ConfigB(CfB(10)) + Val(ConfigB(CfB(11))) 'COLUNA DE SAIDA
If pre = Sh.OLEFormat.Object.Caption & ccs Then
If ConfigB(CfB(2)) = "0" Then
ConfigB(CfB(2)) = 1
Cells(dsL, dsC).Value2 = ConfigB(CfB(4))
Sh.BackgroundStyle = 3
Sh.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground2
Else
If ConfigB(CfB(1)) = "1" Then
ConfigB(CfB(2)) = 0:
Cells(dsL, dsC).Value2 = ConfigB(CfB(3))
Sh.BackgroundStyle = 1:
Sh.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText2
End If
End If
Else
If ConfigB(CfB(1)) = "2" Then
ConfigB(CfB(2)) = "0":
Cells(dsL, dsC).Value2 = ConfigB(CfB(3))
Sh.BackgroundStyle = 1:
Sh.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText2
End If
End If
End If
Sh.AlternativeText = Join(ConfigB, ",")
End If
End If
Next Sh
End With
End If
End Sub
a macro é para as formas funcionarem como botões de comando
Friend... I don’t quite understand what you want... what is a High School control? I think you could detail more what you need and you’ve got it. Demonstrate some code you tried to do and where the doubt is. Maybe then the community can help you better. Hug and success!
– Evert
I am trying to use checkbox or rectangular form with checkbox works in part, but it fails if it is grouped and for some reason fails some boxes in other places if copy and lease the controls with shapes I am seeing how to manage the state, maybe by colors
– Edcronos
@Edcronos, [Edit] your question, and adds more details about what you have and how it works exemplifying the details.
– David
I edited the question, I still do not know if it is clear despite being a little different is the same control situation of the shapes and their attributes
– Edcronos