cs_Kyas
Messages postés5Date d'inscriptionmercredi 9 mars 2011StatutMembreDernière intervention22 mai 2013
-
28 mars 2011 à 13:50
us_30
Messages postés2065Date d'inscriptionlundi 11 avril 2005StatutMembreDernière intervention14 mars 2016
-
29 mars 2011 à 18:16
Bonjour
Je cherche à réaliser une macro capable de selectionner une plage de cellules(les données de la facture réorganisées dans la feuille "Retraitement_relevé") et les copier dans une feuille bien précise et ensuite imprimer la facture.
Voici ce que j'ai trouvé:
Sub Impression_Facture()
'
' Macro1 Macro
'
' Touche de raccourci du clavier: Ctrl+Maj+Z
Sheets("Retraitement_relevé").Select
Range("A6:E6").Select
Selection.Copy
Select Case Range("B3").Value
Case 1
'Num_Facture correspond au N° de facture à traiter
Num_Facture = Sheets("Retraitement_relevé").Range("C6").Value
Sheets("00001").Select
' Définition de la plage a regarder
Dim MaPlage As Range
Set MaPlage = Range("Liste_N°_facture")
' Boucle + Test si Facture existe déjà
For Each Cell In MaPlage
ValeurCellule = Cell.Value
'Si Facture trouvée.. on affiche "ATTENTION!!! Ce N°_Facture existe déja!" et on sort du programme
If Cell.Value = Num_Facture Then
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
MsgBox "ATTENTION !!! Ce N°_ Facture existe déja ! Pour une nouvelle facture : Saisir le N°_FACTURE affiché ci-dessus!"
Exit Sub
End If
Next
ActiveSheet.Unprotect ("1608")
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect ("1608")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2
Case 2
'Num_Facture correspond au N° de facture à traiter
Num_Facture = Sheets("Retraitement_relevé").Range("C6").Value
Sheets("00002").Select
' Définition de la plage a regarder
Set MaPlage = Range("Liste_N°_facture")
' Boucle + Test si Facture existe déjà
For Each Cell In MaPlage
ValeurCellule = Cell.Value
'Si Facture trouvée.. on sort du programme
If Cell.Value = Num_Facture Then
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
MsgBox "ATTENTION !!! Ce N°_ Facture existe déja ! Pour une nouvelle facture : Saisir le N°_FACTURE affiché ci-dessus!"
Exit Sub
End If
Next
ActiveSheet.Unprotect ("1608")
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect ("1608")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2
Case 3
'Num_Facture correspond au N° de facture à traiter
Num_Facture = Sheets("Retraitement_relevé").Range("C6").Value
Sheets("00003").Select
' Définition de la plage a regarder
Set MaPlage = Range("Liste_N°_facture")
' Boucle + Test si Facture existe déjà
For Each Cell In MaPlage
ValeurCellule = Cell.Value
'Si Facture trouvée.. on sort du programme
If Cell.Value = Num_Facture Then
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
MsgBox "ATTENTION !!! Ce N°_ Facture existe déja ! Pour une nouvelle facture : Saisir le N°_FACTURE affiché ci-dessus!"
Exit Sub
End If
Next
ActiveSheet.Unprotect ("1608")
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect ("1608")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2
End Select
End Sub
Mon code marche mais j'ai un probleme:C'est que quand j'exécute la macro,elle marche une fois sur deux;c'est à dire que:
-Premier lancement de la macro : elle marche sans probleme,
-Deuxieme lancement de la macro : elle ne marche pas,mais les évenements suivants se produisent:Le message d'erreur suivant apparait:"Erreur d'exécution '1004',La méthode PasteSpécial de la classe Range a échoué.";ensuite dans la feuille de destination la cellule active est décalée d'une ligne vers le bas.
-Au troisiemme lancement : elle marche comme au premier lancement
-Au quatrieme lancement : elle ne marche pas comme au deuxieme lancement
-Au cinquieme lancement : elle marche comme au premier lancement
-Au sixieme lancement : elle ne marche pas comme au deuxieme lancement
Et ainsi de suite.
Comment éviter le probleme au deuxieme lancement ,pour que la macro marche sans probleme chaque fois qu'on la lance?
bigfish_le vrai
Messages postés1835Date d'inscriptionvendredi 13 mai 2005StatutMembreDernière intervention20 novembre 201315 28 mars 2011 à 16:50
Salut,
pour l'instant je ne vois pas d’où vient le problème mais par contre ta macro est simplifiable !
Sub Impression_Facture()
Dim MaPlage As Range, Cell As Range
' Touche de raccourci du clavier: Ctrl+Maj+Z
With Sheets("Retraitement_relevé")
.Range("A6:E6").Copy
Select Case Range("B3").Value
Case 1
Sheets("00001").Select
Case 2
Sheets("00002").Select
Case 2
Sheets("00003").Select
End Select
'Num_Facture correspond au N° de facture à traiter
Num_Facture = .Range("C6").Value
' Définition de la plage a regarder
Set MaPlage = .Range("Liste_N°_facture")
' Boucle + Test si Facture existe déjà
For Each Cell In MaPlage
ValeurCellule = Cell.Value
'Si Facture trouvée.. on affiche "ATTENTION!!! Ce N°_Facture existe déja!" et on sort du programme
If Cell.Value = Num_Facture Then
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Activate
MsgBox "ATTENTION !!! Ce N°_ Facture existe déja ! Pour une nouvelle facture : Saisir le N°_FACTURE affiché ci-dessus!"
Exit Sub
End If
Next
End With
ActiveSheet.Unprotect ("1608")
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect ("1608")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=2
End Sub
cela devrait faire la même chose mais je n'est pas moyen de tester.
Concernant ton probleme il est tres difficile de savoir d'ou vient le probleme à cause de tout les select et autre changement de feuille utilisés dans ton code.
par exemple :
Dans quelle feuille et sur quelle plage s'applique la ligne : ActiveCell.Offset(1, 0).Select ?
Sur quelle feuille se trouve la plage "Liste_N°_facture" et quel est sont adresse ?
bigfish_le vrai
Messages postés1835Date d'inscriptionvendredi 13 mai 2005StatutMembreDernière intervention20 novembre 201315 28 mars 2011 à 16:58
re petite correction de la simplification car il y a un point qui n'est pas à sa place,
Sub Impression_Facture()
Dim MaPlage As Range, Cell As Range
' Touche de raccourci du clavier: Ctrl+Maj+Z
With Sheets("Retraitement_relevé")
.Range("A6:E6").Copy
Select Case .Range("B3").Value 'il manquait le point
Case 1
Sheets("00001").Select
Case 2
Sheets("00002").Select
Case 2
Sheets("00003").Select
End Select
'Num_Facture correspond au N° de facture à traiter
Num_Facture = .Range("C6").Value
' Définition de la plage a regarder
Set MaPlage = Range("Liste_N°_facture") 'le point était peut être en trop ici !?!
' Boucle + Test si Facture existe déjà
For Each Cell In MaPlage
ValeurCellule = Cell.Value
'Si Facture trouvée.. on affiche "ATTENTION!!! Ce N°_Facture existe déja!" et on sort du programme
If Cell.Value = Num_Facture Then
Application.CutCopyMode = False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Activate
MsgBox "ATTENTION !!! Ce N°_ Facture existe déja ! Pour une nouvelle facture : Saisir le N°_FACTURE affiché ci-dessus!"
Exit Sub
End If
Next
End With
ActiveSheet.Unprotect ("1608")
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Protect ("1608")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Facture").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=2
End Sub
us_30
Messages postés2065Date d'inscriptionlundi 11 avril 2005StatutMembreDernière intervention14 mars 201610 29 mars 2011 à 18:09
Bonjour,
Je ne regarde pas le code original trop indigeste.
Une simple autre remarque de simplification de la version de Le_Vrai_Gros_Poisson :
Select Case .Range("B3").Value 'il manquait le point
Case 1
Sheets("00001").Select
Case 2
Sheets("00002").Select
Case 2
Sheets("00003").Select
End Select
us_30
Messages postés2065Date d'inscriptionlundi 11 avril 2005StatutMembreDernière intervention14 mars 201610 29 mars 2011 à 18:16
Et si on me dit qu'on peut dépasser 9 feuilles, alors on comprend qu'il aurait été plus judicieux de choisir un nom de feuille générique suivi d'un nombre. Par exemple : "feuil1", "feuèil2", etc...