Exécution d'une instruction à chaque passage dans une boucle

**monichou86** · 27/11/2009, 16h11

Hello,

Dans le code suivant, je veux afficher un titre mais en début d'impression du document word. Mais étant donné qu'elle est dans ma boucle While, le titre s'affiche à chaque fois. Donc je voudrais savoir comment faire!!

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
While Sheets("Actions_Engagement").Cells(i%, 2).Value <> ""
 
       If Sheets("Actions_Engagement").Cells(i%, 1).Value <> "Hors Reunion" Then
 
        theme$ = Sheets("Actions_Engagement").Cells(i%, 3).Value
    If Sheets("Actions_Engagement").Cells(i%, 2).Value <> Jalon$ Then
        MRange.Insertbefore ("Décision/Actions du jalon : " & Jalon$)
        MRange.Style = "Titre 1"
End If
MRange.SetRange Start:=MRange.End, End:=MRange.End
        MRange.InsertParagraphAfter
        MRange.InsertParagraphAfter
        MRange.SetRange Start:=MRange.End, End:=MRange.End
        MRange.Insertbefore (theme$)
        MRange.Style = "Titre 1"
        MRange.InsertParagraphAfter
        While Sheets("Actions_Engagement").Cells(i%, 3).Value = theme$
           DOR$ = Sheets("Actions_Engagement").Cells(i%, 4).Value
           MRange.SetRange Start:=MRange.End, End:=MRange.End
           MRange.Insertbefore (DOR$)
           MRange.Style = "Titre 2"
           MRange.InsertParagraphAfter
           MRange.InsertParagraphAfter
[...]
 
             i% = i% + 1
     End If
  Wend

mERCI

**Pierre Fauconnier** · 27/11/2009, 16h18

Bonjour.

Si tu ne veux pas que le titre soit inséré à chaque boucle, il suffit de le sortir de la boucle...

**monichou86** · 27/11/2009, 16h23

Oui je le sais très bien c'est une grande boucle. Cependant je n'arrve pas à la caser sans qu'en exucutant cela ne prenne pas à chaque fois compte du titre. Enfin, voilà!!

**Pierre Fauconnier** · 27/11/2009, 16h30

Tu ne donnes que le code de la boucle, donc, ce n'est pas simple de pouvoir savoir ce qui se passe avant, mais la logique veut que tu sortes de la boucle ce que tu ne veux pas exécuter à chaque passage.

Donc, soit tu le fais avant, soit tu le fais après, mais tu ne le fais pas pendant...

**Pierre Fauconnier** · 27/11/2009, 16h49

Je comprends peut-être un peu mieux l'(in)organisation de ta feuille.

Si la cellule qui contient le titre est placée aléatoirement dans ta feuille, tu peux utiliser une variable booléenne pour savoir si le titre a déjà été placé.

Si la variable est FALSE, tu places le titre et tu passes la variable à TRUE. Ainsi, le titre ne sera placé qu'une seule fois.

Cela étant dit, je suis curieux de voir l'organisation de ton classeur...

**monichou86** · 27/11/2009, 16h51

Pardon je me suis aussi mal exprimé mais c'était dans la précipitation.

Sorry

ah oui j'avais pas penser utiliser une variable booléenne!!!

Great

Voici mon programme en entier que je viens de modifié. Mais je n'ai pas encore intégré ma variable boolean:

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
i% = 2
 While Sheets("Actions_Engagement").Cells(i%, 2).Value <> ""
 
       If Sheets("Actions_Engagement").Cells(i%, 1).Value <> "Hors Reunion" Then
 
        theme$ = Sheets("Actions_Engagement").Cells(i%, 3).Value
        'MRange.SetRange Start:=MRange.End, End:=MRange.End
        If Sheets("Actions_Engagement").Cells(i%, 2).Value <> Jalon$ Then
        MRange.Insertbefore ("Décision/Actions du jalon : " & Jalon$)
        MRange.Style = "Titre 1"
       'MRange.Underline = True
        'flag_titre_1% = 2
        End If
 
 
    'Wend
 
        'If flag_titre_2% = 1 And flag_titre_1% = 2 And Sheets("Actions_Engagement").Cells(i%, 1).Value <> Jalon$ Then
        'MRange.Insertbefore ("Décision/Actions des jalons précédent")
        'MRange.Style = "Titre 1"
        'MRange.Underline = True
        'flag_titre_2% = 2
        'End If
        'If flag_titre_2% = 1 And flag_titre_1% = 1 And Sheets("Actions_Engagement").Cells(i%, 1).Value <> Jalon$ Then
        'MRange.Insertbefore ("Il n'y a pas d'action pris sur le jalon " & Jalon$)
        'MRange.Style = "Titre 1"
        'MRange.Underline = True
        'flag_titre_2% = 2
        'End If
 
        MRange.SetRange Start:=MRange.End, End:=MRange.End
        MRange.InsertParagraphAfter
        MRange.InsertParagraphAfter
        MRange.SetRange Start:=MRange.End, End:=MRange.End
        MRange.Insertbefore (theme$)
        MRange.Style = "Titre 1"
        MRange.InsertParagraphAfter
        While Sheets("Actions_Engagement").Cells(i%, 3).Value = theme$
           DOR$ = Sheets("Actions_Engagement").Cells(i%, 4).Value
           MRange.SetRange Start:=MRange.End, End:=MRange.End
           MRange.Insertbefore (DOR$)
           MRange.Style = "Titre 2"
           MRange.InsertParagraphAfter
           MRange.InsertParagraphAfter
 
          MRange.SetRange Start:=MRange.End, End:=MRange.End
          Set MTable = .Tables.Add(MRange, 1, 6)
          MTable.Cell(1, 1).Range.Text = "Jalon"
          MTable.Cell(1, 2).Range.Text = "Action"
          MTable.Cell(1, 3).Range.Text = "Responsable"
          MTable.Cell(1, 4).Range.Text = "Date cible"
          MTable.Cell(1, 5).Range.Text = "S"
          MTable.Cell(1, 6).Range.Text = "Commentaire"
          MTable.Rows(1).Cells.VerticalAlignment = 1 'wdCellAlignVerticalCenter
          j% = 2
          While Sheets("Actions_Engagement").Cells(i%, 4).Value = DOR$
            MTable.Rows.Add
            MTable.Cell(j%, 1).Range.Text = Sheets("Actions_Engagement").Cells(i%, 1).Value
            MTable.Cell(j%, 2).Range.Text = Sheets("Actions_Engagement").Cells(i%, 5).Value
            MTable.Cell(j%, 3).Range.Text = Sheets("Actions_Engagement").Cells(i%, 6).Value
            MTable.Cell(j%, 4).Range.Text = Sheets("Actions_Engagement").Cells(i%, 7).Value
 
            With MTable.Cell(j%, 5).Shading
              .Texture = 0 ' wdTextureNone
              .ForegroundPatternColor = -16777216 ' wdColorAutomatic
              Select Case Sheets("Actions_Engagement").Cells(i%, 8).Value
              Case "Terminé hors délai"
                .BackgroundPatternColor = 65535 ' wdColorYellow (ex wdColorOrange)
              Case "Terminé dans les délais"
                .BackgroundPatternColor = 65280 ' wdColorBrightGreen
              Case Else
                .BackgroundPatternColor = 255 ' wdColorRed
              End Select
            End With
 
            MTable.Cell(j%, 6).Range.Text = Sheets("Actions_Engagement").Cells(i%, 9).Value
            MTable.Rows(j%).Cells.VerticalAlignment = 1 'wdCellAlignVerticalCenter
            i% = i% + 1
            j% = j% + 1
          Wend
          ' Met les largeurs colonnes
          MTable.Rows(1).Range.ParagraphFormat.Alignment = 1 ' wdAlignParagraphCenter
          MTable.Columns(1).SetWidth ColumnWidth:=MWord.CentimetersToPoints(2.1), RulerStyle:=0 ' wdAdjustNone
          MTable.Columns(2).SetWidth ColumnWidth:=MWord.CentimetersToPoints(6), RulerStyle:=0 ' wdAdjustNone
          MTable.Columns(3).SetWidth ColumnWidth:=MWord.CentimetersToPoints(4), RulerStyle:=0 ' wdAdjustNone
          MTable.Columns(4).SetWidth ColumnWidth:=MWord.CentimetersToPoints(2), RulerStyle:=0 ' wdAdjustNone
          MTable.Columns(5).SetWidth ColumnWidth:=MWord.CentimetersToPoints(0.5), RulerStyle:=0 ' wdAdjustNone
          MTable.Columns(6).SetWidth ColumnWidth:=MWord.CentimetersToPoints(4), RulerStyle:=0 ' wdAdjustNone
          ' met les bordures
          With MTable
            With .Borders(-2) ' wdBorderLeft
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            With .Borders(-4) ' wdBorderRight
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            With .Borders(-1)  ' wdBorderTop
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            With .Borders(-3) ' wdBorderBottom
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            With .Borders(-5) ' wdBorderHorizontal
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            With .Borders(-6) ' wdBorderVertical
              .LineStyle = 1 ' wdLineStyleSingle
              .LineWidth = 4 ' wdLineWidth050pt
              .Color = -16777216 ' wdColorAutomatic
            End With
            .Borders(-7).LineStyle = 0 ' wdBorderDiagonalDown  wdLineStyleNone
            .Borders(-8).LineStyle = 0 ' wdBorderDiagonalUp  wdLineStyleNone
            .Borders.Shadow = False
          End With
 
          Set MRange = .Content
          MRange.SetRange Start:=MRange.End, End:=MRange.End
          MRange.InsertParagraphAfter
          'MRange.InsertParagraphAfter
 
 
 
        Wend
        'Else
             i% = i% + 1
     End If
  Wend

Mais mon programme contient des erreurs.

**Pierre Fauconnier** · 30/11/2009, 20h47

Ton code en vrac ne nous sert pas à grand chose.

Personnellement, je serais plus intéressé par une copie d'écran de la feuille, voire par le classeur tout entier et le document word (en zip, par exemple), avec un bref rappel de ce que tu souhaites réaliser.

Exécution d'une instruction à chaque passage dans une boucle

Macros et VBA Excel

Discussions similaires

Partager

Partager