Bonjour le Forum,
sur mon fichier excel
en cliquant sur le bouton Commande j'arrive sur une boite de dialogue et sur imprim je peux soit en validant sur ok ( CommandButton2 )imprimer ma selection ou sur apèrçu ( CommandButton3 )pour avoir la mise en page.
Tout a l'air de fonctionner normalement seulement losque je selectionne plus de 6 ou 7 zones il y a un blocage
Erreur d'execution'1004'
Impossible de définir la propriété PrintArea de la classe Page Setup
alors que sur 1,2,3,4 ou 5 zone aucun problème
y a t il quelqu'un pour me renseigner voir même m'aider à résoudre se problème
ci-dessous les formules utilisées
Option Explicit
Dim tabAdresses As Variant
Dim i As Integer
Private Sub CommandButton2_Click()
Dim Cpt
Cpt = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'incrémente le compteur
Cpt = Cpt + 1
'définition de la zone d'impression
Dim ZoneImpr As String
ZoneImpr = IIf(Cpt = 1, tabAdresses(i), tabAdresses(i) & "," & ZoneImpr)
ActiveSheet.PageSetup.PrintArea = ZoneImpr
End If
Next i
If Cpt > 0 Then ActiveSheet.PrintOut
Unload Me
End Sub
Private Sub CommandButton3_Click()
Dim Cpt
Cpt = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'incrémente le compteur
Cpt = Cpt + 1
'définition de la zone d'impression
Dim ZoneImpr As String
ZoneImpr = IIf(Cpt = 1, tabAdresses(i), tabAdresses(i) & "," & ZoneImpr)
ActiveSheet.PageSetup.PrintArea = ZoneImpr
End If
Next i
Unload Me
Call Macro1imprim
Unload Me
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim Nom As Name
Dim tabZones As Variant
Dim i As Integer
tabAdresses = Array()
tabZones = Array()
'Recherche de noms dan sla liste des plages nommées
For Each Nom In ActiveWorkbook.Names
If Left(Nom.Name, 7) = "Feuille" And InStr(1, Nom.RefersTo, ActiveSheet.Name) > 0 Then
'affectation aux tableaux
ReDim Preserve tabZones(UBound(tabZones) + 1)
tabZones(UBound(tabZones)) = Nom.Name
ReDim Preserve tabAdresses(UBound(tabAdresses) + 1)
tabAdresses(UBound(tabAdresses)) = Right(Nom.RefersTo, Len(Nom.RefersTo) - 1)
End If
Next Nom
'Remplissage du ListBox
ListBox1.List() = tabZones
End Sub
Vous remerciant par avance
@ + j-fred
sur mon fichier excel
en cliquant sur le bouton Commande j'arrive sur une boite de dialogue et sur imprim je peux soit en validant sur ok ( CommandButton2 )imprimer ma selection ou sur apèrçu ( CommandButton3 )pour avoir la mise en page.
Tout a l'air de fonctionner normalement seulement losque je selectionne plus de 6 ou 7 zones il y a un blocage
Erreur d'execution'1004'
Impossible de définir la propriété PrintArea de la classe Page Setup
alors que sur 1,2,3,4 ou 5 zone aucun problème
y a t il quelqu'un pour me renseigner voir même m'aider à résoudre se problème
ci-dessous les formules utilisées
Option Explicit
Dim tabAdresses As Variant
Dim i As Integer
Private Sub CommandButton2_Click()
Dim Cpt
Cpt = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'incrémente le compteur
Cpt = Cpt + 1
'définition de la zone d'impression
Dim ZoneImpr As String
ZoneImpr = IIf(Cpt = 1, tabAdresses(i), tabAdresses(i) & "," & ZoneImpr)
ActiveSheet.PageSetup.PrintArea = ZoneImpr
End If
Next i
If Cpt > 0 Then ActiveSheet.PrintOut
Unload Me
End Sub
Private Sub CommandButton3_Click()
Dim Cpt
Cpt = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
'incrémente le compteur
Cpt = Cpt + 1
'définition de la zone d'impression
Dim ZoneImpr As String
ZoneImpr = IIf(Cpt = 1, tabAdresses(i), tabAdresses(i) & "," & ZoneImpr)
ActiveSheet.PageSetup.PrintArea = ZoneImpr
End If
Next i
Unload Me
Call Macro1imprim
Unload Me
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
Dim Nom As Name
Dim tabZones As Variant
Dim i As Integer
tabAdresses = Array()
tabZones = Array()
'Recherche de noms dan sla liste des plages nommées
For Each Nom In ActiveWorkbook.Names
If Left(Nom.Name, 7) = "Feuille" And InStr(1, Nom.RefersTo, ActiveSheet.Name) > 0 Then
'affectation aux tableaux
ReDim Preserve tabZones(UBound(tabZones) + 1)
tabZones(UBound(tabZones)) = Nom.Name
ReDim Preserve tabAdresses(UBound(tabAdresses) + 1)
tabAdresses(UBound(tabAdresses)) = Right(Nom.RefersTo, Len(Nom.RefersTo) - 1)
End If
Next Nom
'Remplissage du ListBox
ListBox1.List() = tabZones
End Sub
Vous remerciant par avance
@ + j-fred