3 votes

Utilisation de boutons radio dans un script Excel vba

Je construis une macro pour copier les lignes sélectionnées d'une feuille vers une feuille sélectionnée. Par exemple, je veux copier les lignes 3, 5, 6 et 7 dans la feuille 3. J'ai pensé à utiliser des cases à cocher pour sélectionner les lignes et des boutons radio pour sélectionner la feuille. Dans mon code, je fixe une variable par les boutons radio et cette variable est utilisée pour décider de la feuille dans laquelle les données doivent être copiées.

Public Val As String
Public Sub OptionButton1_Click()
If OptionButton1.Value = True Then Val = "Sheet2"
End Sub

Public Sub OptionButton2_Click()
If OptionButton2.Value = True Then Val = "Sheet3"
End Sub

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "E").Left
        MyTop = Cells(cell, "E").Top
        MyHeight = Cells(cell, "E").Height
        MyWidth = Cells(cell, "E").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell

Application.ScreenUpdating = True

End Sub

Sub CopyRows()

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets(Val)
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":AF" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & ":AF" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

La variable Val est réglée ici par le bouton d'option 1 ou 2. Et cette valeur est utilisée par le Sub CopyRows(). Mais j'obtiens un erreur à la ligne 4 dans CopyRows(). * Il est indiqué "Subscript Out of range". * Vous voyez un problème dans ma logique ou autre chose ? Merci. (Veuillez pardonner les erreurs évidentes car je suis encore en phase d'apprentissage).

8voto

stenci Points 1394

Ce n'est pas vraiment une réponse à votre question, c'est une suggestion sur une alternative à ce que vous faites. Elle n'avait pas sa place dans un commentaire, alors je l'écris ici comme une réponse.

J'ai appris à rester à l'écart des cases à cocher et autres contrôles sur les feuilles. Ils ne sont pas bien gérés par Excel (problèmes de fonctionnement avec des fenêtres multiples, avec des fenêtres divisées, avec de grandes feuilles, impossibilité de créer des centaines de contrôles, etc.), et difficiles à gérer en VBA ou VSTO.

Je fais habituellement quelque chose comme ceci : lorsque l'utilisateur clique sur une cellule, la fonction Worksheet_SelectionChange vérifie si cette cellule contient une case à cocher, un bouton radio ou un bouton. Une cellule contient, ou plutôt est, un bouton radio lorsqu'elle contient le texte "¡" ou "¤" (avec la police Wingdings), une case à cocher lorsqu'elle contient le texte "¨" ou "þ" (toujours Wingdings), un bouton lorsqu'elle contient le texte de votre choix.

Si la cellule sélectionnée est une case d'option, la macro remet toutes les autres cases d'option sur non cochées ("¡") et met la case sélectionnée sur cochée ("¤").

Si la cellule sélectionnée est une case à cocher, la macro remplace le "¨" par le "þ".

S'il s'agit d'un bouton, la macro exécute le code associé au bouton.

Si la cellule sélectionnée est une case à cocher ou un bouton, la macro sélectionne également une autre cellule (sans faux contrôle), afin de permettre à l'utilisateur de cliquer sur le même contrôle et de déclencher à nouveau l'événement.

Voici un exemple de code. Ce code doit se trouver dans un module de feuille de calcul, et non dans un module de code, donc le sous-domaine appelé Worksheet_SelectionChange est reconnu comme un événement de feuille de calcul et est déclenché chaque fois que la sélection sur cette feuille est modifiée.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'exit if the selected range contains more than one cell
  If Target.Columns.Count > 1 Then Exit Sub
  If Target.Rows.Count > 1 Then Exit Sub

  'check for radio buttons
  If Target.Text = "¡" Then
    Application.EnableEvents = False
    Range("B1:B3") = "¡"
    Target = "¤"
    Application.EnableEvents = True
  End If

  'check for check boxes
  If Target.Text = "þ" Then
    Application.EnableEvents = False
    Target = "¨"
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  ElseIf Target.Text = "¨" Then
    Application.EnableEvents = False
    Target = "þ"
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  End If

  'check for button
  Dim Txt As String
  If Target.Text = "[Show stats]" Then
    Txt = "Radio 1 = " & IIf(Range("B1") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Radio 2 = " & IIf(Range("B2") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Radio 3 = " & IIf(Range("B3") = "¤", "Yes", "No") & vbLf
    Txt = Txt & "Check 1 = " & IIf(Range("B5") = "þ", "Yes", "No") & vbLf
    Txt = Txt & "Check 2 = " & IIf(Range("B6") = "þ", "Yes", "No") & vbLf

    MsgBox Txt

    Application.EnableEvents = False
    Target.Offset(0, 1).Select
    Application.EnableEvents = True
  End If
End Sub

Voici un extrait d'une feuille de calcul qui fonctionne avec le code indiqué ci-dessus :

enter image description here

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X