Alternate text of sharpes for saving config

Asked

Viewed 55 times

0

hello
would like to know if there is any problem/risk of using the Alternativetext property of sharpes objects to store working parameters
has some risk of out of nowhere these data being erased/suddenly overwritten by other actions within the office itself?
I am mounting a scheme to use Shape "shapes" as special buttons like groups of option button and checkbox and thought of that space to have the working configuration

as it was not a priority I left a little aside, but part of what I did , has something more advanced but nor found the spreadsheet

Sub SelecDigitoFORMA()
     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     'coluna inicial ( 0 PARA POSSIÇÃO  TopLeftCell)
     CfB(9) = 8     'deslocamento COLUNA
     CfB(10) = 9     '
     CfB(11) = 10     '
     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))     'Cells(2, cs + 1).Value2
          If V = 1 Then

               ' Cells(ConfigB(CfB(6)) + ConfigB(CfB(7)), ConfigB(CfB(8)) + ConfigB(CfB(9))).Value2 = 0    ' Val(ConfigB(CfB(3)))

               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
                                   If ConfigB(CfB(6)) = "0" Then dsL = gcs + ConfigB(CfB(7)) Else dsL = Val(ConfigB(CfB(6))) + ConfigB(CfB(7))     'LINHA DE SAIDA
                                   If ConfigB(CfB(8)) = "0" Then dsC = gcs + ConfigB(CfB(9)) Else dsC = Val(ConfigB(CfB(8))) + ConfigB(CfB(9))     '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
excel vba

1 answer

0

Hello,

All shapes (including Charts) in Excel have the Alternativetext property.

This property can be used to store information. In your case, it is possible to use this property to save parameters without data loss.

Follow an example of use: 

Sub SetAlternativeText()
    Sheet1.Shapes("Rectangle 1").AlternativeText = "ABC"
End Sub 

Sub GetAlternativeText()
    MsgBox Sheet1.Shapes("Rectangle 1").AlternativeText
End Sub

Anyway, it may be possible to do this storage through a global variable.

  • had already done some tests , Until it works well, but for more comprehensive use would have to assemble a whole system . I’m not sure how to use a global for this, since the data are individual marking values and states of objects.

  • You can declare variables outside the function and use them when necessary in any scope of your code. E in case you need to store this data historically, it is also possible to declare a global array and go storing these values in the array.

  • yes, I understand, but I think that this device would only be valid if there is an over load or problem involved with the use of the abilities of the objects themselves, once located the object and reading your Alternativetext you already have the parameters without needing to search in an array and save in spreadsheet , I wanted something that worked as option and selection button

Browser other questions tagged excel vba

You are not signed in. Login or sign up in order to post.