For Each In .Shapes GROUP control for excel [closed]

1

wave
I would like to make a For Each In. Shapes "those shapes" but they grouped I managed to assemble with them ungrouped but grouped it looks like the procedures are different
What I got so far, is a little incomplete because it messed up the macro in trials and tests.

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 
    
asked by anonymous 17.08.2017 / 04:41

0 answers