[VBA-E] Message Blocage Macro

Version imprimable

Bjr,

J'ai une macro qui lance une Macro1 et 2 a la suite.

La Macro1 est la suivante :

Code:

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
 
Sub Macro1()
 
 Application.ScreenUpdating = False
 
    Dim nbLigne As Integer
    Dim MaCellule As Range
    Dim MaCellule_bis As Range
    Dim NumeroLigne As Integer
    Dim ok As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
 
        Worksheets("Feuil1").Select
 
        Sheets("Feuil2").Select
        Columns("A:A").EntireColumn.AutoFit
        Columns("A:A").Select
        Selection.NumberFormat = "m/d/yyyy"
        Sheets("Feuil1").Select
        Columns("A:A").EntireColumn.AutoFit
        Columns("A:A").Select
        Selection.NumberFormat = "m/d/yyyy"
 
    For i = 2 To 20   'Feuil1 colonne 1
 
        For j = 2 To 50
 
            Worksheets("Feuil1").Select
 
            ValeuràChercher = Worksheets("Feuil" & j).Cells(i, 1).Value
 
            MemoNoLigneTrouvée = 0 ''initialise le N° de la ligne trouvée
 
            Range("A2:A3000").Find(What:=ValeuràChercher, After:=Range("A2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Select
 
            ActiveCell.Offset(0, 2).Select
 
            Selection.Copy
            Sheets("Feuil" & j).Select
            Range("E2").Select
            ActiveSheet.Paste
 
            Sheets("Feuil" & j).Select
 
            NumeroLigne = Range("A65000").End(xlUp).Row
 
            Sheets("Feuil" & j).Range("F2").Value = NumeroLigne
 
            Range("F3").Select
            ActiveCell.FormulaR1C1 = "=R[-1]C-1"
            Range("F3").Select
            Selection.Copy
            Range("F2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Range("F3").Select
            Application.CutCopyMode = False
            Selection.ClearContents
 
            If Range("E2").Value >= Range("F2").Value Then Exit Sub Else: Range("G2").Select
            ActiveCell.FormulaR1C1 = "=RC[-2]-RC[-1]"
            Range("H2").Select
            ActiveCell.FormulaR1C1 = "=ABS(RC[-1])"
            Range("H2").Select
            Selection.Copy
            Range("G2").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Range("H2").Select
            Application.CutCopyMode = False
            Selection.ClearContents
 
            nbLigne = Worksheets("Feuil" & j).Cells(2, 7).Value
 
            Set MaCellule = Range("A65000").End(xlUp)
            Set MaCellule_bis = Range("A65000").End(xlUp).Offset(1, 0)
            MaCellule_bis.Offset(-nbLigne, 0).Resize(nbLigne).EntireRow.Select
 
            Selection.Cut
 
            Sheets.Add
            ActiveSheet.Select
 
            Range("A2").Select
            ActiveSheet.Paste
            Range("A1").Select
            Application.CutCopyMode = False
            ActiveCell.FormulaR1C1 = "Date"
            Range("B1").Select
            ActiveCell.FormulaR1C1 = "IMP/NIMP"
            Range("C1").Select
            ActiveCell.FormulaR1C1 = "Référence"
            Range("D1").Select
            Range("A1:C1").Select
            Selection.Font.Bold = True
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
 
            Sheets("Calendrier").Select
            Columns("B:B").Select
            Selection.NumberFormat = "m/d/yyyy"
 
            'Feuil1 colonne 1
 
            Worksheets("Calendrier").Select
 
            k = j + 1
 
            ValeuràChercher = Worksheets("Feuil" & k).Cells(i, 1).Value
 
            MemoNoLigneTrouvée = 0 ''initialise le N° de la ligne trouvée
 
            Range("B2:B3000").Find(What:=ValeuràChercher, After:=Range("B2"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Select
 
            ActiveCell.Offset(1, 0).Select
 
            Sheets("Calendrier").Select
            Selection.Copy
            Sheets("Feuil" & k).Select
            Range("E2").Select
            ActiveSheet.Paste
            Columns("A:A").Select
            Application.CutCopyMode = False
            Selection.ClearContents
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "Date"
            Range("E2").Select
            Selection.Copy
            Range("A2").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Application.CutCopyMode = False
            Selection.Copy
            Range("A3").Select
            ActiveSheet.Paste
            Range("A2", "A" & Range("B65536").End(xlUp).Row) = Range("A2")
 
            ActiveWindow.SmallScroll Down:=291
 
        Next j
    Next i
 
Application.ScreenUpdating = True
 
End Sub

La macro 2 est la suivante :

Code:

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
 
Sub Macro2()
 
 Dim fd As Worksheet ' Feuille destination
 Dim fs As Worksheet 'Feuille source (de la copie)
 
 Sheets.Add
 Set fd = ThisWorkbook.ActiveSheet 'On défini ici la feuille destination
 
 'Efface Feuille destination
 
  fd.Activate
 
 'Ecriture de l'entête sur Feuille destination
 
 fd.Cells(1, 1) = "Date"
 fd.Cells(1, 2) = "NIMP"
 fd.Cells(1, 3) = "Référence "
 
 For Each fs In ThisWorkbook.Worksheets
 
    If fs.Name <> fd.Name And fs.Name <> "Feuil1" And fs.Name <> "Calendrier" Then
    ' on va pas copier la feuille destination ...
    Debug.Print "Copie des données de " & fs.Name
    fs.Range(fs.Cells(2, 1), fs.Cells(1, 1).SpecialCells(xlLastCell)).Copy 'On copie à partir 1° ligne
    fd.Cells(fd.Cells(1, 1).CurrentRegion.Rows.Count + 1, 1).Select ' On se place sur cellule suivante le tableau récap
    fd.Paste ' on colle...
 
   End If
 
 Next
 
    Columns("A:A").Select
    Range("A1:C3000").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
        ActiveSheet.Name = "Résumé"
 
        Columns("D:I").Select
        Selection.Delete Shift:=xlToLeft
 
End Sub

Je possède dans ma feuil1 un tableau avec 4 colonnes : Date/Qté IMP/Capacité Totale/Capacité Résiduelle.

La Feuil2 possède elle 3 colonnes : Date du jour/IMP.NIMP/Référence

Les 2 macros réalisent la chose suivante :

Elle recherche la date présente dans la feuille 2 dans la feuil1.
Elle sélectionne sa Capacité Résiduelle et elle le copie dans la Feuil 2.
Elle compte le nombre de ligne de la feuil 2.
On calcule la valeur Nombre de ligne-Capacité résiduelle.
On sélectionne le nombre de ligne correspondant à cette valeur à compter de la X lignes (X valeur Capacité résiduelle).
On fait un couper de ces lignes et on les place dans une nouvelle feuil.
On recherche alors dans la feuil "Calendrier" notre date et on copie la cellule qui la suit.
Cette valeur est alors coller dans la premiere colonne de notre nouvelle feuil.
On réalise à nouveau la meme action pour cette nouvelle date et pour toutes celles qui suivent jusqu'à ce que le nombre de ligne soit inférieur à la valeur de la capacité résiduelle.

Voila mon probleme est le suivant :
Parfois certaine personne oublie de saisir certaine date dans la Feuil1 avec leurs capacité résiduelle du cou le programme se retrouve dans une feuil ou la capacité résiduelle est inférieure au nombre de ligne mais il ne peut pas continuer la boucle car il manque la date du lendemain et sa capacité résiduelle.

Ce que je veux c'est qu'un message indiquant "Vous avez oublier de saisir la capacité pour certaines dates!!" apparaisse dans ce cas la.

En résume je veux quelque chose dans le genre : si qd je suis dans la derniere feuil j'ai ma valeur capacité résiduelle inférieur au nombre de ligne alors afficher le message.

J'espere avoir été clair.

Merci à tous.

24/11/2005, 09h33
ouskel'n'or

Tu travailles sur un userform ou tu lances la macro depuis une feuille Excel ?

La meilleure façon de régler le pb est de créer une grille de saisie perso (sur un userform - et non la grille Excel qui est insuffisante pour ça) et de tester chaque champ de saisie. Ou alors, de créer un formulaire, mais là, je ne connais pas et ne peux donc pas t'aider.
Outre la vérification des champs saisis, une grille perso te permet de vérifier le format des données saisies, leur cohérence avec le type de donnée attendu... etc.
Tu peux même empêcher l'utilisateur d'accéder directement à la feuille de calcul, ce qui peut (trééés souvent) être (trèèèès) utile !

Tu nous dis

A+
24/11/2005, 10h02
beurnoir

En fait j'ai créé un formulaire pour saisir les valeurs de date et de capacité apres grace a une requete j'obtiens la valeur capacité résiduelle.

Toutes ces valeurs sont alors renvoyées de Access vers la Feuil1 du fichier Copie de Test d'Excel.

Il te faut d'autres infos??
24/11/2005, 10h34
ouskel'n'or

Citation:

Il te faut d'autres infos??

Non, pas pour ce qui me concerne :

Citation:

Ou alors, de créer un formulaire, mais là, je ne connais pas et ne peux donc pas t'aider.

Désolé de me citer... mais il y aura bien quelqu'un pour te répondre

A+
24/11/2005, 10h41
Megaxel

Bon, je n'ai pas eu le courage de suivre ton code, alors je suis allé directement à la fin. Tu dis qu'

Citation:

il ne peut pas continuer la boucle

Il y a une erreur? Tu ne peux pas simplement l'intercepter avec un "On Error" (même si en général, je les déconseille...) et afficher ton message?
Et si je lis ton "résumé": s'il n'y a pas d'erreur, et qu'à la fin du traitement, tu comptes tes lignes et que tu compares ça à la valeur "capacité résiduelle", quel est le problème?
24/11/2005, 10h47
beurnoir

Le probleme a lieu apres lorsqu'il y a une valeur capacité résiduelle infèrieur au nombre de ligne dans ce cas la boucle continue du cou il va aller chercher les valeurs de la dates du lendemain dans la Feuil1 mais cette valeur est absente car elle n'a pas été saisi du cou erreur.

Merci
24/11/2005, 11h14
ouskel'n'or

C'est donc le nombre de lignes qui colle pas. Comment le définis-tu ?

Comme je m'en vais, je laisse à "d'autres Megaxel" te rouver la parade...

Ä+
24/11/2005, 11h16
Megaxel

Bon, alors puisque tu as la cause exacte de ton problème, fais le test de comparaison entre le nombre de lignes et ta valeur résiduelle, et si c'est inférieur, affiche ton message d'alerte, et bloque ta macro.
C'est quoi, le problème? Je me sens tout bête, sur ce post...
:)
24/11/2005, 11h20
beurnoir

Le probleme c'est que je dois faire cela uniquement pour la derniere feuil dont je ne connais pas la valeur car c'est une boucle du cou ca peut etre la feuil 4 ou 5 ou 6...

Voila le coeur du probleme en fait.

Merci
24/11/2005, 11h33
beurnoir

Pardon??
24/11/2005, 13h10
SfJ5Rpw8

pas trés clair ......

c'est quoi :

Citation:

avec leurs capacité résiduelle du cou

ou il est ce cou ..
?
24/11/2005, 13h20
beurnoir

Ok c'est bon j'ai compris forcement avec un on error pas besoin de faire attention aux feuil.

Merci.
24/11/2005, 13h35
beurnoir
J'ai essayé ca :
Code:

1 2 On Error GoTo Macro3
Et dans ma macro 3 j'ai ca :
Code:

1 2 3 4 5 6 7 8 9 Sub Macro3() ' ' Macro3 Macro ' Macro enregistrée le 07/11/2005 par pommbe01 ' MsgBox "Il manque la capacité de la date du lendemain" End Sub
Mais ca ne fonctionne pas, j'ai le message d'erreur suivant :
Erreur de compilation
Etiquette non définie

Merci

Citation:
Envoyé par beurnoir
J'ai essayé ca :
Code:

1 2 On Error GoTo Macro3
Et dans ma macro 3 j'ai ca :
Code:

1 2 3 4 5 6 7 8 9 Sub Macro3() ' ' Macro3 Macro ' Macro enregistrée le 07/11/2005 par pommbe01 ' MsgBox "Il manque la capacité de la date du lendemain" End Sub
Mais ca ne fonctionne pas, j'ai le message d'erreur suivant :
Erreur de compilation
Etiquette non définie

Merci
Salut,

Ya une petite erreur au niveau de la gestion d'erreur (un comble non ?)

Plus sérieusement, ta partie de code doit être la suivante :
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub MacroExErr() ' Début de la macro '.... On Error GoTo ErrHandler '.... ' Suite de ta macro ' Fin normale de ta macro Exit Sub ErrHandler: MsgBox "Il manque la capacité de la date du lendemain" End Sub
Voilà car le "On Error Goto" renvoi à une balise qui se trouve dans la procédure (macro) ou la fonction.

Bonne continuation

Théo

24/11/2005, 13h54
beurnoir

Ah ok bah c'est cool merci bcp.
24/11/2005, 14h25
ouskel'n'or

A Beurnoir :
J'ai dit :

Citation:

Normal, tu es "zUne BÊTE !"

Beurnoir a dit :

Citation:

Pardon??

En fait je répondais à Megaxel qui avait dit :

Citation:

C'est quoi, le problème? Je me sens tout bête, sur ce post...

Je n'avais pas prévu que tu me coupes la parole... :wink:
24/11/2005, 15h13
Megaxel

Ok, en fait, tu n'avais pas compris ce que je te disais sur la gestion d'erreur. Désolé de ne pas avoir été plus clair, ça t'aurait fait gagner du temps.