Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Frame avec chekbox

2 réponses
Avatar
Nicolas
Je cr=E9=E9 une bo=EEte de dialogue avec une frame contenant des=20
checkboxs correspondant =E0 certaines feuilles d'un classeur=20
susceptibles d'=EAtre imprim=E9es;la pas de probl=E8me :

Private Sub UserForm_Initialize()
Dim monTabFeuill
Dim maFeuil As Worksheet
Dim mesfeuill, i%
mesfeuill =3D Application.Sheets.Count
ReDim monTabFeuill(mesfeuill)
For i =3D LBound(monTabFeuill) To UBound(monTabFeuill)
Set maFeuil =3D ActiveWorkbook.Worksheets(i)
monTabFeuill(i) =3D maFeuil.Name
Next i
Application.ScreenUpdating =3D False
Dim chkPage As Control 'chk correspond aux checkbox=20
qui vont etre cr=E9=E9s
Dim valtop As Integer 'valtop correspond a la hauteur=20
initiale de la 1ere checbox creee
Dim tailleSBR As Integer
=20
'creation du nb de checkbox correspondant aux nb de=20
rayons
valtop =3D -10
tailleSBR =3D 10
For i =3D LBound(monTabFeuill) To UBound(monTabFeuill)
If monTabFeuill(i) <> "BG SISCO" _
And monTabFeuill(i) <> "BG PDV" _
And monTabFeuill(i) <> "Dbase RMS" _
And monTabFeuill(i) <> "Dbase Marges & CA" Then
Set chkPage =3D fmImprTous.Controls.Add
("Forms.CheckBox.1")
With chkPage
.Left =3D 6
.Top =3D valtop + 13
.Width =3D 140
.Height =3D 16
.Caption =3D monTabFeuill(i)
End With
valtop =3D chkPage.Top
tailleSBR =3D tailleSBR + 13
End If
Next i

' 'definition de la taille de la scrollbar de F_rayons
=20
If tailleSBR <=3D fmImprTous.Height Then
fmImprTous.KeepScrollBarsVisible =3D fmScrollBarsNone
Else
fmImprTous.KeepScrollBarsVisible =3D=20
fmScrollBarsVertical
fmImprTous.ScrollBars =3D fmScrollBarsVertical
fmImprTous.ScrollHeight =3D tailleSBR
End If
=20
End Sub

Lorsque je s=E9lectionne ces feuilles pour =EAtre imprim=E9es en=20
les placant dans un tableau je re=E7ois un message d'erreur :
"Indice en dehors de la plage (erreur 9) :


Private Sub btnImprimer_Click()
dim Arr(),x&
'Selection des pages en cochant les checkboxs
For i =3D 1 To fmImprTous.Controls.Count
x =3D -1
If fmImprTous.Controls(i).Value =3D True Then
x =3D x + 1
ReDim Preserve Arr(x) 'Erreur 9
Arr(x) =3D fmImprTous.Controls.Caption
End If
Next i
'Impression des feuilles s=E9lectionn=E9es
Sheets(Arr).Select
ActiveWindow.SelectedSheets.printout
Unload Me
End Sub

Qu'est-ce que j'ai fail de mal !
Merci pour le secours

2 réponses

Avatar
Denis Michon
Bonjour Nicolas,

Remplace ceci (ton code)
'----------------------
For i = 1 To fmImprTous.Controls.Count
x = -1
If fmImprTous.Controls(i).Value = True Then
x = x + 1
ReDim Preserve Arr(x) 'Erreur 9
Arr(x) = fmImprTous.Controls.Caption
End If
Next i
'----------------------


PAR : SOLUTION : celle que je préfère ...

'--------------------
Dim i As Integer, x As Integer, Arr()

x = fmImprTous.Controls.Count

'le tableau va débuter avec l'index 1 comme entrée de la première valeur(tableau de base 1)
ReDim Arr(1 To x)

'Utilise ceci si ton entrée doit avoir la valeur zéro
ReDim Arr(x) ' Lorsque non spécifie dans la définition de la variable tableau(array), le tableau est de bas 0

For i = 1 To fmImprTous.Controls.Count
If fmImprTous.Controls(i).Value = True Then
Arr(x) = fmImprTous.Controls.Caption
End If
Next i
'--------------------


Tu peux aussi utiliser ceci :

Dim i As Integer, x As Integer, Arr()

x = -1
For i = 1 To fmImprTous.Controls.Count
x = x + 1
If fmImprTous.Controls(i).Value = True Then
ReDim Preserve Arr(x)
Arr(x) = fmImprTous.Controls.Caption
End If
Next i


Salutations!




"Nicolas" a écrit dans le message de news:fed301c3be41$1c6998e0$
Je créé une boîte de dialogue avec une frame contenant des
checkboxs correspondant à certaines feuilles d'un classeur
susceptibles d'être imprimées;la pas de problème :

Private Sub UserForm_Initialize()
Dim monTabFeuill
Dim maFeuil As Worksheet
Dim mesfeuill, i%
mesfeuill = Application.Sheets.Count
ReDim monTabFeuill(mesfeuill)
For i = LBound(monTabFeuill) To UBound(monTabFeuill)
Set maFeuil = ActiveWorkbook.Worksheets(i)
monTabFeuill(i) = maFeuil.Name
Next i
Application.ScreenUpdating = False
Dim chkPage As Control 'chk correspond aux checkbox
qui vont etre créés
Dim valtop As Integer 'valtop correspond a la hauteur
initiale de la 1ere checbox creee
Dim tailleSBR As Integer

'creation du nb de checkbox correspondant aux nb de
rayons
valtop = -10
tailleSBR = 10
For i = LBound(monTabFeuill) To UBound(monTabFeuill)
If monTabFeuill(i) <> "BG SISCO" _
And monTabFeuill(i) <> "BG PDV" _
And monTabFeuill(i) <> "Dbase RMS" _
And monTabFeuill(i) <> "Dbase Marges & CA" Then
Set chkPage = fmImprTous.Controls.Add
("Forms.CheckBox.1")
With chkPage
.Left = 6
.Top = valtop + 13
.Width = 140
.Height = 16
.Caption = monTabFeuill(i)
End With
valtop = chkPage.Top
tailleSBR = tailleSBR + 13
End If
Next i

' 'definition de la taille de la scrollbar de F_rayons

If tailleSBR <= fmImprTous.Height Then
fmImprTous.KeepScrollBarsVisible = fmScrollBarsNone
Else
fmImprTous.KeepScrollBarsVisible fmScrollBarsVertical
fmImprTous.ScrollBars = fmScrollBarsVertical
fmImprTous.ScrollHeight = tailleSBR
End If

End Sub

Lorsque je sélectionne ces feuilles pour être imprimées en
les placant dans un tableau je reçois un message d'erreur :
"Indice en dehors de la plage (erreur 9) :


Private Sub btnImprimer_Click()
dim Arr(),x&
'Selection des pages en cochant les checkboxs
For i = 1 To fmImprTous.Controls.Count
x = -1
If fmImprTous.Controls(i).Value = True Then
x = x + 1
ReDim Preserve Arr(x) 'Erreur 9
Arr(x) = fmImprTous.Controls.Caption
End If
Next i
'Impression des feuilles sélectionnées
Sheets(Arr).Select
ActiveWindow.SelectedSheets.printout
Unload Me
End Sub

Qu'est-ce que j'ai fail de mal !
Merci pour le secours
Avatar
Frédéric Sigonneau
Bonsoir,

Tu peux aussi te passer d'un tableau pour sélectionner les feuilles à imprimer
(en supposant que le nom d'une feuille à sélectionner soit bien récupérable dans
fmImprTous.Controls(i).Caption) :

Private Sub btnImprimer_Click()
'Selection des pages en cochant les checkboxs
For i = 1 To fmImprTous.Controls.Count
If fmImprTous.Controls(i).Value = True Then
Sheets(fmImprTous.Controls(i).Caption).Select False
End If
Next i
'Impression des feuilles sélectionnées
ActiveWindow.SelectedSheets.printout
Unload Me
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Je créé une boîte de dialogue avec une frame contenant des
checkboxs correspondant à certaines feuilles d'un classeur
susceptibles d'être imprimées;la pas de problème :

Private Sub UserForm_Initialize()
Dim monTabFeuill
Dim maFeuil As Worksheet
Dim mesfeuill, i%
mesfeuill = Application.Sheets.Count
ReDim monTabFeuill(mesfeuill)
For i = LBound(monTabFeuill) To UBound(monTabFeuill)
Set maFeuil = ActiveWorkbook.Worksheets(i)
monTabFeuill(i) = maFeuil.Name
Next i
Application.ScreenUpdating = False
Dim chkPage As Control 'chk correspond aux checkbox
qui vont etre créés
Dim valtop As Integer 'valtop correspond a la hauteur
initiale de la 1ere checbox creee
Dim tailleSBR As Integer

'creation du nb de checkbox correspondant aux nb de
rayons
valtop = -10
tailleSBR = 10
For i = LBound(monTabFeuill) To UBound(monTabFeuill)
If monTabFeuill(i) <> "BG SISCO" _
And monTabFeuill(i) <> "BG PDV" _
And monTabFeuill(i) <> "Dbase RMS" _
And monTabFeuill(i) <> "Dbase Marges & CA" Then
Set chkPage = fmImprTous.Controls.Add
("Forms.CheckBox.1")
With chkPage
.Left = 6
.Top = valtop + 13
.Width = 140
.Height = 16
.Caption = monTabFeuill(i)
End With
valtop = chkPage.Top
tailleSBR = tailleSBR + 13
End If
Next i

' 'definition de la taille de la scrollbar de F_rayons

If tailleSBR <= fmImprTous.Height Then
fmImprTous.KeepScrollBarsVisible = fmScrollBarsNone
Else
fmImprTous.KeepScrollBarsVisible > fmScrollBarsVertical
fmImprTous.ScrollBars = fmScrollBarsVertical
fmImprTous.ScrollHeight = tailleSBR
End If

End Sub

Lorsque je sélectionne ces feuilles pour être imprimées en
les placant dans un tableau je reçois un message d'erreur :
"Indice en dehors de la plage (erreur 9) :

Private Sub btnImprimer_Click()
dim Arr(),x&
'Selection des pages en cochant les checkboxs
For i = 1 To fmImprTous.Controls.Count
x = -1
If fmImprTous.Controls(i).Value = True Then
x = x + 1
ReDim Preserve Arr(x) 'Erreur 9
Arr(x) = fmImprTous.Controls.Caption
End If
Next i
'Impression des feuilles sélectionnées
Sheets(Arr).Select
ActiveWindow.SelectedSheets.printout
Unload Me
End Sub

Qu'est-ce que j'ai fail de mal !
Merci pour le secours