Boucle conditions qui déconne + problème Msgbox

arnaudbu · 2 Décembre 2010

Hello,

Je teste en F sur certaines lignes si il y a un "X". Si il y a un "X", je contrôle le remplissage de la ligne.

Si la ligne n'est pas correctement remplie, je renvoie une erreur Msgbox.
Si la ligne n'est pas correctement remplie, on ne copie aucunes données.

Voilà le soucis:

Si il y a plusieurs erreurs de remplissage je me retrouve avec beaucoup de Msgbox. Comment mettre toutes les erreurs dans un seul Msgbox séparées par sauts de lignes?

Si il y a des erreurs, mes lignes sont quand même copiées, je ne trouve pas le soucis ??

@++

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Bonjour à tous

Adaptation :

Code:

[COLOR=DarkSlateGray][B]Option Explicit

Dim rs As Range, rd As Range
Dim TabLignes() As Variant, TabNC() As Variant
Dim i As Integer, j As Integer
Dim Msg As String
Dim FlgErr As Boolean

'---------------------------------------------'

Sub archivage()
Msg = "" [COLOR=DarkOrange]'(Si vous voulez absolument utiliser des variables globales, il faut les gérer !)[/COLOR]

TabLignes = Array(4, 9) [COLOR=DarkOrange]'Avec Array(4, 5), vous ne traitez que les lignes 4 et 5.
' Cette façon de faire vous oblige à modifier le code chaque fois que le nombre
' de lignes à traiter change. Est-ce bien raisonnable ?[/COLOR]
TabNC = Array("G", "H", "I", "J", "K", "L", "M", "N")

[COLOR=DarkOrange]' Pour la suite : un programme n'est pas un paquet d'instructions en vrac.
' L'ordre dans lequel on les dispose a un petit peu d'importance...[/COLOR]

With Sheets("feuil1")

    For i = TabLignes(0) To TabLignes(1) [COLOR=DarkOrange]' Et non LBound(TabLignes) To UBound(TabLignes)
    ' qui renvoie toujours 0 To 1[/COLOR]
            
        FlgErr = False
        
        If .Range("F" & i).Value = "X" Then
            
            For j = LBound(TabNC) To UBound(TabNC)
                
                If .Range(TabNC(j) & i).Value = "" Then
                
                    If Not FlgErr Then FlgErr = True: Msg = "Critères: " & .Range("B" & i).Value & " Manque: "
                    
                    Msg = Msg & " " & .Range(TabNC(j) & "2").Value
                    
                End If
            
            Next j
               
            If FlgErr Then Msg = Msg & vbLf [COLOR=DarkOrange]' Ici, et pas deux ou trois lignes plus loin...[/COLOR]
        
        End If
    
    Next i
            
    If Msg = "" Then
                
        Application.ScreenUpdating = False [COLOR=DarkOrange]' C'est mieux ici qu'ailleurs.[/COLOR]
        
        For i = TabLignes(0) To TabLignes(1)
        
            If .Range("F" & i).Value = "X" Then
                
                Set rd = Sheets("feuil2").Range("A65536").End(xlUp).Offset(1, 0)
                Set rs = .Range("I" & i).Resize(1, 7)
                rs.Copy
                rd.PasteSpecial xlValues
                rd.PasteSpecial xlFormats
  
            End If
         
        Next i
        
        With Application
            .CutCopyMode = False
            .ScreenUpdating = True
        End With
     
        Msg = "sauvegardées" [COLOR=DarkOrange]' Rien à voir avec Msg = MsgBox("sauvegardées", vbOKOnly, "Information")[/COLOR]
     
    End If
    
End With

MsgBox Msg, vbOKOnly, "Information"

End Sub[/B][/COLOR]

ROGER2327
#4644

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T11:58:08Z

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Hello,

Merci je vais refaire un test. J'avais avancé et réussi à faire fonctionner tout ça.

c'était une de mes questions. C'est quoi la différence entre dim msg as long et dim msg$ ??

J'ai essayé votre code mais il ne copie q'une ligne même avec erreur.
Je vous montre le mien... 🙁

@+

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

j'aimerais aussi savoir à quoi correspond cette ligne:

Code:

Msg = Msg & " " & IIf(j > 20, Chr((j + 5) \ 26 + 64), "") & Chr((j + 5) Mod 26 + 65)

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Code:

For i = TabLignes(0) To TabLignes(1) [COLOR="DarkOrange"]' Et non LBound(TabLignes) To UBound(TabLignes)
    ' qui renvoie toujours 0 To 1

[/COLOR]

C'est la même chose alors si ça renvoi 0 To 1 ?? J'ai testé et les deux fonctionnent ...

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Re...

(…) J'ai essayé votre code mais il ne copie q'une ligne même avec erreur. (…)

Si le classeur joint au message #16 ne fonctionne pas, je n'ai rien à ajouter et je passe la main.

(…) C'est quoi la différence entre Dim msg as Long et dim msg$ (…)

Dans le premier cas, msg désigne une variable de type Long (entier long, 0 par défaut), dans le second une variable de type String (chaîne de caractères, "" par défaut). Aucun rapport entre les deux…

IIf(j > 20, Chr((j + 5) \ 26 + 64), "") & Chr((j + 5) Mod 26 + 65)

convertit j, entier de 1, 2, 3, ..., 696 en chaîne de caractères G, H, I, ..., ZZ. Dans l'utilisation que vous en faites dans le classeur du message #17, il faudrait écrire IIf(j > 19, Chr((j + 6) \ 26 + 64), "") & Chr((j + 6) Mod 26 + 65) puisque j = 0 (et non 1) correspond à G. Mais ce calcul n'a plus lieu d'être puisque vous déclarez un tableau TabNC = Array("G", "H", ...) comme référence aux colonnes à traiter : TabNC(j) fera l'affaire.

ROGER2327
#4645

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T14:36:22Z

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Re...

arnaudbu à dit:
Code:

For i = TabLignes(0) To TabLignes(1) [COLOR=DarkOrange]' Et non LBound(TabLignes) To UBound(TabLignes)[/COLOR] [COLOR=DarkOrange] ' qui renvoie toujours 0 To 1[/COLOR]

C'est la même chose alors si ça renvoi 0 To 1 ?? J'ai testé et les deux fonctionnent ...

Parfait ! Tout va bien…

Vous disiez plus haut :

(…) Ceci est une version allégée de mon fichier donc non représentatif. (…)

Si je peux me permettre une suggestion : Ne serait-il pas temps de donner une version moins "allégée", mais plus "représentative" de ce que vous cherchez à faire en réalité ?

ROGER2327
#4646

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T14:47:44Z

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Votre fichier fonctionne, j'ai corrigé mes erreurs.

Version allégées oui mais représentative de ce que je voulais.

Je souhaite gardé les array car mes lignes à contrôler ne sont pas toutes les unes en dessous des autres.

Ligne 1,2,3,4,8,9,10,14,16,18,19,20 etc...
Pour les colonnes c'est pareil A,C,D,K,L,N,P,Q

j'ai adpaté le code.

J'ai bien compris pour les variables. En mettant i% c'est comme i as integer non ?

For i = TabLignes(0) To TabLignes(1) ' Et non LBound(TabLignes) To UBound(TabLignes)
' qui renvoie toujours 0 To 1

Est ce bien ce que j'ai compris ?? ou faut il préférer votre version, je sens un peu de 😱

Par contre, si je n'ai aucune X en F sur toutes ma feuille, comment éviter le lancement du code ?

MERCI POUR VOTRE PATIENCE 😱

kjin · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Bonjour,

arnaudbu à dit:
Boucle conditions qui déconne

Je suis moins certain que se soit la boucle !
Tu as eu plusieurs propositions et à aucun moment tu n'as daigné repondre alors que mon message de 9h49 me paraissait clair !
kjin

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

kjin à dit:
Bonjour,

Je suis moins certain que se soit la boucle !
Tu as eu plusieurs propositions et à aucun moment tu n'as daigné repondre alors que mon message de 9h49 me paraissait clair !
kjin

Non regardes bien avant de dire que je déconne , je t'ai répondu !

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Re...

arnaudbu à dit:
Votre fichier fonctionne, j'ai corrigé mes erreurs. (…)

Dont acte.

arnaudbu à dit:
(…)
Version allégées oui mais représentative de ce que je voulais. (…)

Oui, sauf que :

arnaudbu à dit:
(…) Je souhaite gardé les array car mes lignes à contrôler ne sont pas toutes les unes en dessous des autres.

Ligne 1,2,3,4,8,9,10,14,16,18,19,20 etc...
Pour les colonnes c'est pareil A,C,D,K,L,N,P,Q (…)

Rien de représentatif de cela dans votre fichier d'exemple.

arnaudbu à dit:
(…) J'ai bien compris pour les variables. En mettant i% c'est comme i as integer non ? (…)

Farpaitement !

arnaudbu à dit:
(…) Est ce bien ce que j'ai compris ?? ou faut il préférer votre version, je sens un peu de 😱

Par contre, si je n'ai aucune X en F sur toutes ma feuille, comment éviter le lancement du code ?

MERCI POUR VOTRE PATIENCE 😱

Gardez votre code avec les quelques modifications que voici (pour prendre en compte la gestion de toutes les variables, gérer les types de message et tenir compte du cas où aucune donnée n'est à traiter) :

Code:

[COLOR=DarkSlateGray][B]Option Explicit[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim i As Integer, j As Integer[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim TabNC() As Variant, TabLignes() As Variant[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim Msg$[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim FlgErr As Boolean[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim rd As Range, rs As Range[/B][/COLOR]
[COLOR=DarkSlateGray][B] [COLOR=DarkOrange]'-----------------------------------------------------'[/COLOR][/B][/COLOR]

[COLOR=DarkSlateGray][B] Sub archivage()[/B][/COLOR]

[COLOR=DarkSlateGray][B] Dim MsgType[/B][B] As Long[/B][/COLOR]
[COLOR=DarkSlateGray][B] MsgType = vbCritical[/B][/COLOR]

[COLOR=DarkSlateGray][B] With Sheets("Feuil1")[/B][/COLOR]

[COLOR=DarkSlateGray][B] TabLignes = Array(4, 5, 6, 7, 8, 9)[COLOR=DarkOrange] ' À adapter.[/COLOR][/B][/COLOR]
[COLOR=DarkSlateGray][B] TabNC = Array("G", "H", "I", "J", "K", "L", "M", "N") [COLOR=DarkOrange]' À adapter.[/COLOR][/B][/COLOR]
[COLOR=DarkSlateGray][B] Msg = "" [SIZE=3][COLOR=DarkOrange]'(INDISPENSABLE : Si vous voulez absolument utiliser des variables globales, il faut les gérer !)[/COLOR][/SIZE][/B][/COLOR]

[COLOR=DarkSlateGray][B] FlgErr = False[/B][/COLOR]

[COLOR=DarkSlateGray][B] For i = LBound(TabLignes) To UBound(TabLignes)[/B][/COLOR]

[COLOR=DarkSlateGray][B]     If .Range("F" & TabLignes(i)).Value = "X" Then FlgErr = True[/B][/COLOR]

[COLOR=DarkSlateGray][B] Next i[/B][/COLOR]

[COLOR=DarkSlateGray][B] If Not FlgErr Then Exit Sub[/B][/COLOR]

[COLOR=DarkSlateGray][B] For i = LBound(TabLignes) To UBound(TabLignes)[/B][/COLOR]

[COLOR=DarkSlateGray][B] FlgErr = False[/B][/COLOR]

[COLOR=DarkSlateGray][B]     If .Range("F" & TabLignes(i)).Value = "X" Then[/B][/COLOR]

[COLOR=DarkSlateGray][B]         For j = LBound(TabNC) To UBound(TabNC)[/B][/COLOR]

[COLOR=DarkSlateGray][B]             If .Range(TabNC(j) & TabLignes(i)).Value = "" Then[/B][/COLOR]

[COLOR=DarkSlateGray][B]               If Not FlgErr Then[/B][/COLOR]
[COLOR=DarkSlateGray][B]                 FlgErr = True[/B][/COLOR]
[COLOR=DarkSlateGray][B]                 Msg = Msg & "Critère : " & .Range("B" & TabLignes(i)) & " Manque :"[/B][/COLOR]
[COLOR=DarkSlateGray][B]               End If[/B][/COLOR]
[COLOR=DarkSlateGray][B]               Msg = Msg & " " & TabNC(j)[/B][/COLOR]

[COLOR=DarkSlateGray][B]             End If[/B][/COLOR]

[COLOR=DarkSlateGray][B]         Next j[/B][/COLOR]

[COLOR=DarkSlateGray][B]     If FlgErr Then Msg = Msg & vbLf[/B][/COLOR]

[COLOR=DarkSlateGray][B]     End If[/B][/COLOR]

[COLOR=DarkSlateGray][B] Next i[/B][/COLOR]

[COLOR=DarkSlateGray][B] If Msg = "" Then[/B][/COLOR]

[COLOR=DarkSlateGray][B]     Application.ScreenUpdating = False[/B][/COLOR]

[COLOR=DarkSlateGray][B]     For i = LBound(TabLignes) To UBound(TabLignes)[/B][/COLOR]

[COLOR=DarkSlateGray][B]         FlgErr = False[/B][/COLOR]

[COLOR=DarkSlateGray][B]             If .Range("F" & TabLignes(i)).Value = "X" Then[/B][/COLOR]

[COLOR=DarkSlateGray][B]                 Application.ScreenUpdating = False[/B][/COLOR]

[COLOR=DarkSlateGray][B]                 Set rd = Sheets("feuil2").Range("A65536").End(xlUp).Offset(1, 0)[/B][/COLOR]
[COLOR=DarkSlateGray][B]                 Set rs = .Range("I" & TabLignes(i)).Resize(1, 7)[/B][/COLOR]

[COLOR=DarkSlateGray][B]                 rs.Copy[/B][/COLOR]
[COLOR=DarkSlateGray][B]                 rd.PasteSpecial xlValues[/B][/COLOR]
[COLOR=DarkSlateGray][B]                 rd.PasteSpecial xlFormats[/B][/COLOR]

[COLOR=DarkSlateGray][B]             End If[/B][/COLOR]

[COLOR=DarkSlateGray][B]     Next i[/B][/COLOR]

[COLOR=DarkSlateGray][B]         With Application[/B][/COLOR]
[COLOR=DarkSlateGray][B]             .CutCopyMode = False[/B][/COLOR]
[COLOR=DarkSlateGray][B]             .ScreenUpdating = True[/B][/COLOR]
[COLOR=DarkSlateGray][B]         End With[/B][/COLOR]

[COLOR=DarkSlateGray][B]         Msg = "Les données ont été sauvegardées avec succès"[/B][/COLOR]
[COLOR=DarkSlateGray][B]         MsgType = vbOKOnly[/B][/COLOR]

[COLOR=DarkSlateGray][B] End If[/B][/COLOR]

[COLOR=DarkSlateGray][B] End With[/B][/COLOR]

[COLOR=DarkSlateGray][B] MsgBox Msg, MsgType, "Information"[/B][/COLOR]

[COLOR=DarkSlateGray][B] End Sub[/B][/COLOR]

Ouf !

ROGER2327
#4647

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T15:41:32Z

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Re,

Code:

 For i = LBound(TabLignes) To UBound(TabLignes)
     If .Range("F" & TabLignes(i)).Value = "X" Then FlgErr = True
 Next i
 If Not FlgErr Then Exit Sub

c'est pas si value = "" then ....

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Re...

Je ne crois pas, mais essayez pour voir ce que ça donne…

ROGER2327
#4651

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T17:36:42Z

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Non c'est tout bon.

Encore merci et @++

ROGER2327 · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

Suite...

On peut aussi écrire :

Code:

[COLOR=DarkSlateGray][B]Sub archivage()

 Dim MsgType As Long
 MsgType = vbCritical

 With Sheets("Feuil1")

 TabLignes = Array(4, 5, 6, 7, 8, 9)
 TabNC = Array("G", "H", "I", "J", "K", "L", "M", "N") 
 Msg = "" 

 For i = LBound(TabLignes) To UBound(TabLignes)

     If .Range("F" & TabLignes(i)).Value = "X" Then Exit For

 Next i

 If i > UBound(TabLignes) Then Exit Sub[/B][/COLOR]

et la suite sans changement.

ROGER2327
#4652

Mardi 3 Sable 138 (Saint Phlegmon, doctrinaire, SQ)
13 Frimaire An CCXIX
2010-W48-5T17:48:00Z

arnaudbu · 3 Décembre 2010

Re : Boucle conditions qui déconne + problème Msgbox

OK, je garde ça dans un coin. Je crois que j'ai eu ma dose avec ce code ... 😉

Je vais me faire oublier un temps ...

Encore merci @+

Boucle conditions qui déconne + problème Msgbox

arnaudbu

XLDnaute Occasionnel

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

arnaudbu

XLDnaute Occasionnel

Pièces jointes

arnaudbu

XLDnaute Occasionnel

arnaudbu

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

arnaudbu

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

arnaudbu

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

arnaudbu

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

arnaudbu

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

arnaudbu

XLDnaute Occasionnel

Discussions similaires

Boucle conditions qui déconne + problème Msgbox

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency