Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Mudar GroupName de ...
 
Notifications
Clear all

Mudar GroupName de OptionButton - VBA

 
2024 - VBA & Macros
Post Recente por tomazcpv 9 anos atrás
9 Posts
2 Usuários
0 Reactions
1,897 Visualizações
RSS
 tomazcpv
(@tomazcpv)
Posts: 29
Eminent Member
Topic starter
 

Boa Tarde Pessoal!

Tenho uma planilha que cria um questionário com 2 perguntas, no menu da planilha o usuario digita o nº de aves que ele quer aplicar o questionario, de acordo com o que o usuário digita é criado Radio buttons para cada pergunta x numero de aves.

O processo de criação esta pronto, o que não estou conseguindo fazer é mudar a propriedade "GROUPNAME" de cada conjunto de optionbuttons, para que a seleção possa ser feita de maneira correta, atualmente posso escolher apenas 1 opção , dentre todos os radios da planilha, justamente porque o groupname é igual para todos.

Na planilha que deixo anexo, o usuário coloca o numero de Aves que ele quer aplicar o questionário, e no questionário ele escolhe um opção de cada pergunta para cada ave.

Tentei usar checkbox mas como o usuário iria poder escolher somente uma resposta, não funcionou muito bem, então decidi usar o radiobtn mas cai em outro problema, em que todos os botoes ficam no mesmo groupname.

obs: todos os conjuntos de botoes tem de ser criados via código, porque esse numero será dinâmico, por isso não posso colocar os groupnames manualmente.

Se alguem tiver alguma idéia com checkbox tb aceito a sugestão.

 
Postado : 31/01/2016 2:29 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente:

Sub grupos()
Dim I as Integer, y as Integer
I = 0
For y = 1 To ThisWorkbook.Sheets("Menu").Range("H13").Value * 2
    For x = 1 To 3
        ActiveSheet.Shapes("OptionButton" & x + I).OLEFormat.Object.Object.GroupName = "teste" & y
    Next
    I = I + 3
Next
End Sub

Obs.: http://gurudoexcel.com/forum/viewtopic.php?f=12&t=1346 e http://www.tomasvasquez.com.br/forum/vi ... =20&t=4259

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 01/02/2016 8:53 am
 tomazcpv
(@tomazcpv)
Posts: 29
Eminent Member
Topic starter
 

Reinaldo obrigado pela, resposta, porem gostaria de saber se eu não conseguiria atribuir o nome do grupo no momento em que crio o optionbtn , pois não são todos os casos que tem 3 opções, algumas perguntas são de apenas 2 opçoes.

Tentei colocar a lógica aqui diretamente na criação do optionbutton, mas deu erro!

 
Postado : 01/02/2016 2:06 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O problema maior está em entendera logica para atribuiçao do grupo.
Os botões são criados de 1 á n em cada passada.
Para alterar o nome do grupo na criação, pode ser conforme abaixo
Obs.: incluido apenas na linha 5 deve extender para asdemais

        'Adicionando Checkbox linha 5
            MyLeft = Cells(5, 4 + x).Left
            MyTop = Cells(5, 4 + x).Top
            'MyHeight = Cells(5, 4 + x).Height
            'MyWidth = MyHeight = Cells(5, 4 + x).Width

            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste" & x

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 02/02/2016 6:07 am
 tomazcpv
(@tomazcpv)
Posts: 29
Eminent Member
Topic starter
 

Reinaldo ele até inseriu o groupName Teste, mas não sei o que ocorre que somente os 3 primeiros radios ficou com o nome de teste1 e todos os outros ficaram com o nome da planilha, ou seja não atribuiu corretamente, dessa forma a seleção dos radio ficou inconsistente.

Sub IniciarAvaliacao()

Application.ScreenUpdating = False

Sheets("QualidadeIntestinal").Select

    Dim x As Integer
    Dim MyLeft As Double
    Dim MyTop As Double
    Dim MyHeight As Double
    Dim MyWidth As Double
    Dim pctCompl As Single


        For x = 1 To ThisWorkbook.Sheets("Menu").Range("H13").Value
        'Adicionando as Aves
            ThisWorkbook.Sheets("QualidadeIntestinal").Cells(4, 4 + x).Value = "Ave " & x
            
'Adicionando Radio linha 5 - Perg.1
            MyLeft = Cells(5, 4 + x).Left
            MyTop = Cells(5, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste"
            
            'Adicionando Radio  linha 6
            MyLeft = Cells(6, 4 + x).Left
            MyTop = Cells(6, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste"
             
            'Adicionando Radio linha 7
            MyLeft = Cells(7, 4 + x).Left
            MyTop = Cells(7, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste"
            
            'Adicionando Radio na linha 10 - Perg.2
            MyLeft = Cells(10, 4 + x).Left
            MyTop = Cells(10, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste1"
            
            'Adicionando Radio linha 11
            MyLeft = Cells(11, 4 + x).Left
            MyTop = Cells(11, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste1"
            
            'Adicionando Radio linha 12
            MyLeft = Cells(12, 4 + x).Left
            MyTop = Cells(12, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes("OptionButton" & x).OLEFormat.Object.Object.GroupName = "teste1"
            
        Next x
        
        For Each oLe In ActiveSheet.OLEObjects
            oLe.Object.SpecialEffect = 0
  
        Next
        

    Application.ScreenUpdating = True
    
End Sub
 
Postado : 02/02/2016 7:08 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Altere onde consta "OptionButton" & x para Selection.Name a linha :=-->ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName....

"seleção dos radio ficou inconsistente"

A consistência você deve determinar; é preciso deixar claro qual grupo de radios "trabalham em equipe"

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 02/02/2016 8:57 am
 tomazcpv
(@tomazcpv)
Posts: 29
Eminent Member
Topic starter
 

OK Reinaldo, eu até consegui fazer funcionar , mas o codigo ficou meio BruteForce, queria saber se teria como melhorar

estou tendo que basicamente nomear os Groupnames a cada tres opçãoes, ( lembrando que esse exemplo é só 2 questoes, a planilha completa tem muito mais, e algumas questoes tem 2 ou mais opções.

A numeração dos grupos encontra-se em imagem anexo

Sub IniciarAvaliacao()

Application.ScreenUpdating = False

Sheets("QualidadeIntestinal").Select

    Dim x As Integer
    Dim MyLeft As Double
    Dim MyTop As Double
    Dim MyHeight As Double
    Dim MyWidth As Double
    Dim pctCompl As Single
    Dim i As Integer
    i = 0


        For x = 1 To ThisWorkbook.Sheets("Menu").Range("H13").Value
            'Adicionando as Aves
            ThisWorkbook.Sheets("QualidadeIntestinal").Cells(4, 4 + x).Value = "Ave " & x
            
            i = i + x
            
            'Adicionando Checkbox linha 5 - Perg.1
            MyLeft = Cells(5, 4 + x).Left
            MyTop = Cells(5, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i

            'Adicionando Checkbox linha 6
            MyLeft = Cells(6, 4 + x).Left
            MyTop = Cells(6, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i
             
            'Adicionando Checkbox linha 7
            MyLeft = Cells(7, 4 + x).Left
            MyTop = Cells(7, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i
            
            i = i + 1
            
            'Adicionando Checkbox linha 10 - Perg.2
            MyLeft = Cells(10, 4 + x).Left
            MyTop = Cells(10, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i
            
            'Adicionando Checkbox linha 11
            MyLeft = Cells(11, 4 + x).Left
            MyTop = Cells(11, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i
            
            'Adicionando Checkbox linha 12
            MyLeft = Cells(12, 4 + x).Left
            MyTop = Cells(12, 4 + x).Top
            ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
            DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
            ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "teste" & i

            
        Next x
        
    Application.ScreenUpdating = True
    
End Sub
 
Postado : 02/02/2016 12:01 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se notar, em minha primeira sugestão, baseado em seu modelo, era isso que estava executando.
Porem a solicitação e nova informação: "atribuir o nome do grupo no momento em que crio" / "algumas perguntas são de apenas 2 opçoes"; indica que não há um algorítimo especifico.
Assim segue minha sugestão:

Sub IniciarAvaliacao1()
'Declaração de variaveis
Dim x As Integer
Dim MyLeft As Double, MyTop As Double

Application.ScreenUpdating = False
Sheets("QualidadeIntestinal").Select

For x = 1 To ThisWorkbook.Sheets("Menu").Range("H13").Value
    'Adicionando as Aves
    ThisWorkbook.Sheets("QualidadeIntestinal").Cells(4, 4 + x).Value = "Ave " & x
            
    'Adicionando Radio linha 5 - Perg.1
    MyLeft = Cells(5, 4 + x).Left
    MyTop = Cells(5, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x
            
    'Adicionando Radio  linha 6
    MyLeft = Cells(6, 4 + x).Left
    MyTop = Cells(6, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x
             
    'Adicionando Radio linha 7
    MyLeft = Cells(7, 4 + x).Left
    MyTop = Cells(7, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x
            
    'Adicionando Radio na linha 10 - Perg.2
    MyLeft = Cells(10, 4 + x).Left
    MyTop = Cells(10, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x & 1
            
    'Adicionando Radio linha 11
    MyLeft = Cells(11, 4 + x).Left
    MyTop = Cells(11, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x & 1
            
    'Adicionando Radio linha 12
    MyLeft = Cells(12, 4 + x).Left
    MyTop = Cells(12, 4 + x).Top
    ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, _
    DisplayAsIcon:=False, Left:=MyLeft, Top:=MyTop, Width:=12, Height:=12).Select
    ActiveSheet.Shapes(Selection.Name).OLEFormat.Object.Object.GroupName = "Grupo" & x & 1
Next x
        
For Each Ole In ActiveSheet.OLEObjects
    Ole.Object.SpecialEffect = 0
Next
Application.ScreenUpdating = True
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 03/02/2016 6:19 am
 tomazcpv
(@tomazcpv)
Posts: 29
Eminent Member
Topic starter
 

È a situação foi essa mesma Reinaldo, acabei deixando desse jeito mesmo, como são muitas perguntas a execução acabou ficando um pouco pesada, mas funcionou corretamente, isso que importa.

Muito obrigado por sua colaboração amigo, Deus lhe abencoe!

 
Postado : 03/02/2016 7:06 am
Forum Jump:
  Tópico Anterior
Próximo Tópico