modification du code ajout feuille

**grisan29** · 23/09/2010, 12h51

bonjour a vous
je voudrais que ce code soit modifié afin de pouvoir créer des pages dans la feuille et non des feuilles comme le fait ce code que m'a gentiment donné zyhack

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
For boucle = 2 To 255
  'Vérifier si une autre feuille facturation existe
  nomFeuille = "facturation(" & boucle & ")"
  On Error Resume Next
  test = Sheets(nomFeuille).Name
  On Error GoTo 0: Err.Clear
 
  If test <> nomFeuille Then 'la feuille n'existe pas il faut la créer
    Set nouvellefeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    nouvellefeuille.Name = nomFeuille
 
    'Collage des ligne à reporter
        'en-tête
    Sheets("facturation").Rows(LigneMinFact1 - 3 & ":" & LigneMinFact1 - 1).Copy
    nouvellefeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteValues
    nouvellefeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteFormats
        'Format tableau des lignes
    Sheets("facturation").Rows(LigneMinFact1).Copy
    nouvellefeuille.Rows(LigneMinFactS).PasteSpecial Paste:=xlPasteFormats
        'les deux dernieres ligne
    Sheets("facturation").Rows(LigneMaxFact1 & ":" & LigneMaxFact1 + 1).Copy
    nouvellefeuille.Rows(LigneMinFactS + 1 & ":" & LigneMinFactS + 2).PasteSpecial Paste:=xlPasteFormats
        'Largeur des colonnes
    Sheets("facturation").Cells.Copy
    nouvellefeuille.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
 
        'Réécriture des formules
    With nouvellefeuille
      .Range("L" & LigneMinFactS + 2).FormulaLocal = "=SOMME(L" & LigneMinFactS & ":L" & LigneMinFactS + 1 & ")"
      .Range("O" & LigneMinFactS + 2).FormulaLocal = "=SOMME(O" & LigneMinFactS & ":O" & LigneMinFactS + 1 & ")"
      .Range("P" & LigneMinFactS + 2).FormulaLocal = "=SOMME(P" & LigneMinFactS & ":P" & LigneMinFactS + 1 & ")"
    End With
 
    LigneSuivante = nomFeuille & "," & LigneMinFactS
    'comme la feuille vient d'être créé on sait ou ecrire donc quitter la fonction
    Exit Function
  Else
 
    'chercher si une ligne est vide dans la feuille facturation(x)
    With Worksheets(nomFeuille)
      For Each Cellule In .Range(.Cells(LigneMinFactS, 3), .Cells(LigneMaxFactS, 3))
        If Cellule = "" Then
          LigneSuivante = nomFeuille & "," & Cellule.Row
          Exit For
        End If
      Next
      If Not Cellule Is Nothing Then _
        If Cellule.Row > LigneMinFactS And Cellule.Row < LigneMaxFactS Then .Rows(Cellule.Row).Insert Shift:=xlDown
      'si une ligne vide est trouvé -> sortir
      If LigneSuivante <> "" Then Exit Function
    End With
  End If
Next
End Function

merci de votre compréhension et si vous avez des questions n'hesiter pas

cordialement

Pascal

**AlainTech** · 23/09/2010, 13h09

As-tu déjà essayé l'enregistreur de macro?

Tu le lances, tu insères tes sauts de pages et tu regardes le code généré.

Il ne te reste plus qu'à nettoyer ce code de tous les Select et autres ActiveCell/Sheet/Row et à l'intégrer à ton code.

**grisan29** · 23/09/2010, 20h29

bonsoir AlainTech

jamais essayé l'enregistreur de macro? je ne sais pas comment faire pour les sauts de pages étant donné que mon fichier demarre avec 23 lignes et fini a 70 avec ce code, d'autant plus que la ligne 17 est copiée et collée ainsi que devrai etre la ligne 64 et 65 que j'ai oublié de signaler a zyhack lors qu'il m"a créer ce code
d'autant plus que le code ne démarrai que lorsque la ligne 51 etait rempli
enfin je vais essayer mais je ne garanti pas du resultat

merci quand meme de ta réponse

bonne soirée

Pascal

**grisan29** · 24/09/2010, 12h49

bonjour AlainTech

j'ai essayé l'enregistreur de macro?????????????

voici ce qu'il m'a fait comme code qui plante le reste des codes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function essai_saut()
'
' essai_saut Macro
'
 
'
    ActiveWindow.SmallScroll Down:=-27
    Range("C1:M70,C75:L145").Select
    Range("C75").Activate
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.SmallScroll Down:=3
    Range("C1:M70,C75:L145,C150:L205").Select
    Range("C150").Activate
    ActiveWindow.SmallScroll Down:=-177
    Rows("17:17").Select
    Range("B17").Activate
    Selection.Copy
    ActiveWindow.SmallScroll Down:=72
    Rows("92:92").Select
    Range("B92").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=66
    Rows("167:167").Select
    Range("B167").Activate
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-111
    Rows("38:39").Select
    Range("B38").Activate
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=84
    Range("C139").Select
    ActiveWindow.SmallScroll Down:=3
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-75
End Function

a commencer par celui-ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 newLig = CLng(OuEcrire(1))

mauvaise manip ou peu de connaissance de l'enregistreur de macros

bonne apres midi

Pascal

**AlainTech** · 24/09/2010, 16h52

Bon, ok.
Commence par le début.
Reprends le code de zyhack et simplifie-le pour tout écrire dans la même feuille.

Je sais, ça va te demander de réfléchir un peu.
Si tu as un doute sur une ligne, écris-nous, on va essayer de te guider pas à pas.
N'hésite pas à utiliser l'aide (F1) si tu ne comprends pas une syntaxe.

**grisan29** · 26/09/2010, 18h15

bonjour AlainTech

pour commencer je n'ai pas joint le code au complet que m'a fait zyhack
donc voici

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Function LigneSuivante() As String
  'Ligne début et fin d'écriture sur la feuille Facturation
Const LigneMinFact1 As Byte = 19, LigneMaxFact1 As Byte = 51
  'Ligne début et fin d'écriture sur les feuilles Facturation suivante
Const LigneMinFactS As Byte = 7, LigneMaxFactS As Byte = 51
 
Dim nouvellefeuille As Worksheet
Dim Cellule As Range
Dim boucle As Byte
Dim test As String, nomFeuille As String
 
LigneSuivante = ""
 
'chercher si une ligne est vide dans la feuille facturation
With Worksheets("facturation")
  For Each Cellule In .Range(.Cells(LigneMinFact1, 3), .Cells(LigneMaxFact1, 3))
    If Cellule = "" Then
      LigneSuivante = "facturation," & Cellule.Row
      Exit For
    End If
  Next
  If Not Cellule Is Nothing Then _
    If Cellule.Row > LigneMinFact1 And Cellule.Row < LigneMaxFact1 Then .Rows(Cellule.Row).Insert Shift:=xlDown
  'si une ligne vide est trouvé -> sortir
  If LigneSuivante <> "" Then Exit Function
End With
 
'For boucle = 2 To 255
  'Vérifier si une autre feuille facturation existe
  'nomFeuille = "facturation(" & boucle & ")"
  'On Error Resume Next
  'test = Sheets(nomFeuille).Name
 'On Error GoTo 0: Err.Clear
 
  'If test <> nomFeuille Then 'la feuille n'existe pas il faut la créer
    'Set nouvellefeuille = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    'nouvellefeuille.Name = nomFeuille
 
    'Collage des ligne à reporter
        'en-tête
    Sheets("facturation").Rows(LigneMinFact1 - 3 & ":" & LigneMinFact1 - 1).Copy
    nouvellefeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteValues
    nouvellefeuille.Rows(LigneMinFactS - 3 & ":" & LigneMinFactS - 1).PasteSpecial Paste:=xlPasteFormats
        'Format tableau des lignes
    Sheets("facturation").Rows(LigneMinFact1).Copy
    nouvellefeuille.Rows(LigneMinFactS).PasteSpecial Paste:=xlPasteFormats
        'les deux dernieres ligne
    Sheets("facturation").Rows(LigneMaxFact1 & ":" & LigneMaxFact1 + 1).Copy
    nouvellefeuille.Rows(LigneMinFactS + 1 & ":" & LigneMinFactS + 2).PasteSpecial Paste:=xlPasteFormats
        'Largeur des colonnes
    Sheets("facturation").Cells.Copy
    nouvellefeuille.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
 
        'Réécriture des formules
    With nouvellefeuille
      .Range("L" & LigneMinFactS + 2).FormulaLocal = "=SOMME(L" & LigneMinFactS & ":L" & LigneMinFactS + 1 & ")"
      .Range("O" & LigneMinFactS + 2).FormulaLocal = "=SOMME(O" & LigneMinFactS & ":O" & LigneMinFactS + 1 & ")"
      .Range("P" & LigneMinFactS + 2).FormulaLocal = "=SOMME(P" & LigneMinFactS & ":P" & LigneMinFactS + 1 & ")"
    End With
 
    LigneSuivante = nomFeuille & "," & LigneMinFactS
    'comme la feuille vient d'être créé on sait ou ecrire donc quitter la fonction
    Exit Function
  'Else
 
    'chercher si une ligne est vide dans la feuille facturation(x)
    With Worksheets(nomFeuille)
      For Each Cellule In .Range(.Cells(LigneMinFactS, 3), .Cells(LigneMaxFactS, 3))
        If Cellule = "" Then
          LigneSuivante = nomFeuille & "," & Cellule.Row
          Exit For
        End If
      Next
      If Not Cellule Is Nothing Then _
        If Cellule.Row > LigneMinFactS And Cellule.Row < LigneMaxFactS Then .Rows(Cellule.Row).Insert Shift:=xlDown
      'si une ligne vide est trouvé -> sortir
      If LigneSuivante <> "" Then Exit Function
    End With
  'End If
'Next
End Function

cela fait tout le week end que je passe dessus et tout ce que j'ai réussi a faire est de planter excel par blocage, j'ai tout réinstaller et ressayer, je vais etre absent professionnellement 2 semaines(peut etre moins) et si je simplifie le fichier je ne sais pas par ou commencer tellement il est barbare pour moi qui ne connais que tres peu des variables

merci quand meme car je sais que vous n'etes pas la pour faire le travail des autres ,vous avez assez avec le votre

des mon retour je te tiens au courant

cordialement

Pascal

**AlainTech** · 27/09/2010, 21h59

Bonsoir,

Donc, apparemment, tu ne comprends pas le code qui t'a été fourni.
J'en conclus (mais ce n'est que mon avis, et je n'affirme pas avoir raison) que zyhack ne t'a pas rendu service en faisant les choses à ta place.

Reprenons ton code généré par l'enregistreur.
Ce code reproduit les gestes que tu as fait. Nous allons l'analyser:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function essai_saut()
'
' essai_saut Macro
'
 
'
    ActiveWindow.SmallScroll Down:=-27

Ici tu as déplacé l'ascenseur dans la feuille active.
Ca n'a pas beaucoup d'intérêt pour le programme
On peut donc supprimer cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Range("C1:M70,C75:L145").Select
    Range("C75").Activate

Dans les 2 lignes qui précèdent tu as sélectionné un Range

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.SmallScroll Down:=3

Idem que plus haut, déplacement dans la feuille. Inutile. A supprimer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Range("C1:M70,C75:L145,C150:L205").Select
    Range("C150").Activate

Tu sélectionnes un autre Range. Tu perds donc la sélection précédente.
Le code correspondant peut être supprimé et ne garder que ce dernier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ActiveWindow.SmallScroll Down:=-177

Encore du déplacement inutile. A supprimer.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Rows("17:17").Select
    Range("B17").Activate

Tiens, tu as encore changé d'avis. Tout ce qui est au dessus peut donc être supprimé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    Selection.Copy

Tu copies la sélection.
Comme tu as dû le lire quelques fois, il faut éviter les Select.
Il vaut mieux écrire les 3 lignes ci-dessus sous cette forme:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Rows("17:17").Copy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ActiveWindow.SmallScroll Down:=72

Encore du déplacement inutile.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Rows("92:92").Select
    Range("B92").Activate
    ActiveSheet.Paste

Tu choisis de coller ce que tu as copié en ligne 92 mais l'enregistreur y a mis des Select et Activate, on va donc simplifier toute l'opération de copier/coller en une seule ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Rows("17:17").Copy Rows("92:92")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ActiveWindow.SmallScroll Down:=66

Déplacement à supprimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Rows("167:167").Select
    Range("B167").Activate
    ActiveSheet.Paste

Comme tu veux copier ta ligne 17 plusieurs fois, on va répéter l'opération précédente:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Rows(17).Copy Rows(167)

Tu remarqueras que, comme tu ne dois traiter qu'une ligne, tant dans la source que dans la destination, il n'est pas nécessaire d'utiliser cette syntaxe: "17:17". Le numéro de la ligne suffit.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ActiveWindow.SmallScroll Down:=-111

Toujours inutile...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    Rows("38:39").Select
    Range("B38").Activate
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=84
    Range("C139").Select
    ActiveWindow.SmallScroll Down:=3
    ActiveSheet.Paste

Dans ce qui précède, tu copies 2 lignes vers la cellule C139.
En simplifiant comme plus haut:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Rows("38:39").Copy Range("C139")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    ActiveWindow.SmallScroll Down:=-75

Toujours inutile

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

End Function

Ce qui donne, en finale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Function essai_saut()
  Rows(17).Copy Rows(92)
  Rows(17).Copy Rows(167)
  Rows("38:39").Copy Range("C139")
End Function

Essaye de commencer à coder ce que tu veux faire en te basant sur les éléments fournis.

Maintenant, je vais me coucher car je me lève tôt, demain.
Postes-nous ce que tu auras commencé à faire et on continuera à te guider mais, de grâce, ne copie pas bêtement du code que tu ne comprends pas, tu vas droit dans le mur.

Bonne chance et bon boulot.

**grisan29** · 02/10/2010, 10h16

bonjour AlainTechet le forum

ce n'est pas que je ne comprends les fonctions du code que zyhack m'a fait, juste que je ne sais pas a partir d'ou le changement de page se fait dans ce code
je suis rentré ce week end pour voir ce que je peux faire mais je ne peux pas y passer les 2 jours; avec mon portable j'ai essayer a l'hotel et tout ce que j'arrive a faire c'est causer un défaut de code ailleurs qui ne trouve plus sa référence et pourtant je ne trouve pas les mêmes écriture dans les 2 codes.
a part cela la formule que j'ai fait avec l'enregistreur de macro ne me plait pas car j'y ai inégrer des pages supplémentaire hors elles devrai etre ajouté automatiquement bref je plane complet

cordialement

Pascal

modification du code ajout feuille [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager