Aide sur une boucle

br44 · 21 Octobre 2007

Bonjour le forum ,

Voilà mon petit problème . J'ai deux classeurs le premier est mon classeur de facture ("F.xls")le deuxième est mon classeur pour le suivi client("SC.xls").

j'ai une boucle qui copie des informations du classeur("F.xls") vers le classeur("SC.Xls")
les èlèments copier sont simplement:

1-le N° de facture
2-la date de Facture
3-le montantant de la facture

voici la boucle consernèe:

'Déclare le Chemin2 vers "SC.xls"
Dim Chemin2 As String
'Dèclare la variable Wb4
Dim Wb4 As Workbook
'Declare la Variable C
Dim C As String
'Declare la Variable MP
Dim MP As Range
'Declare la Variable R
Dim R As Range

'Dèfinit la varible C
C = Workbooks("F.Xls").Sheets("Détail").Range("G3").Value
'Dèfinit la varible Chemin2
Chemin2 = "C:\RAPID\GESTION\Sc.XLS"
'Dèfinit la varaible Wb4
Set Wb4 = Workbooks.Open(Chemin2)
'Dèfinit la variable MP
Set MP = Workbooks("SC.xls").Sheets(Mois).Range("A4:A" & Range("A65536").End(xlUp).Row)

'Boucle sur la plage R et MP
For Each R In MP
'Défintit la condition de la plage C
If R.Value = C Then
'Définit et envoie les valeures vers le classeur "SC.XLS"
With Wb2.Sheets("Facture")
.Range("C16").Copy
End With
R.Offset(0, 3).PasteSpecial xlPasteValues

With Wb2.Sheets("Facture")
.Range("F12").Copy
End With
R.Offset(0, 4).PasteSpecial xlPasteValues

With Wb2.Sheets("Facture")
.Range("G39").Copy
End With
R.Offset(0, 5).PasteSpecial xlPasteValues
'Sort de la boucle
Exit For
'Fin de Condition
End If
'Sort de la plage p
Next R

Application.CutCopyMode = False
'Enregistre les données du classeur "SC.XLS"
Wb4.Save
'Ferme le Classeur "SC.XLS"
Wb4.Close

On ma demmander de modifier le program pour pouvoire enregistrer des prestations suplèmentaire que certain client ,ses dernierniers dèsire que les nouvelles prestations soit facturèes à parts ,j'ai donc conçu des "annexes factures" pour cela . Mon problème est pouvoir envoyer les èlèments des "annex factures" vers le classeur " Sc.XLS" pour chaque les clients consernès .
Les èlèments à envoyer ètant indentiques à ceux de la facture je les repris pour crèer une macro me permetant de copiers les èlèments consernès, de fusionner et enfin de rèajuster les hauteures de lignes pour garder le formats des cellules .

Voici la macros rajouter:

With Wb2.Sheets("Annexfacture1")
.Range("C16").Copy
End With
R.Offset(1, 3).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture1")
.Range("F12").Copy
End With
R.Offset(1, 4).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture1")
.Range("G38").Copy
End With
R.Offset(1, 5).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture2")
.Range("C16").Copy
End With
R.Offset(2, 3).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture2")
.Range("F12").Copy
End With
R.Offset(2, 4).PasteSpecial xlPasteValues

With Wb2.Sheets("Annexfacture2")
.Range("G38").Copy
End With
R.Offset(2, 5).PasteSpecial xlPasteValues

Range("A16:A18,B16:B18,C16:C18").MergeCells = False
Range("A16:A18,B16:B18,C16:C18").MergeCells = True
Rows("16:18").RowHeight = 14.25

Le problèmes est que je voudrais que la dernière partie ne s'execute que pour les clients consernès ,or dans cette configuration la boucle s'applique à tous .
Ma question est donc :

Est-il possible de modifier la boucle pour quelle prenne en compte la deuxième partie du program que pour mes clients conserès ?

Les rèfèrence des clients consernèes sont:

1- "C18"
2- "C19"

A Noter : je n'ai pas mis le procèdure pour le second clients je l'adderais en fonction des informations qui me sera transmises il me faudrait juste la condition .

Pour l'insertions des lignes supplèmentaires elle se fait automatiquement lors de la validations des "annex factures" .

En espèrant avoir ètè claire (cette fois si) dans mes explications .jeremercie par avance tous ceux qui pourront m'aider à rèsoudre se petit problème .
A bientôt BR 44

MJ13 · 21 Octobre 2007

Re : Aide sur une boucle

Bonjour BR44

Il faut l'avouer, sans fichier, c'est pas simple à résoudre!

Épaf · 21 Octobre 2007

Re : Aide sur une boucle

Bonjour BR44,
Tu devrais baliser ton code, ainsi il est difficile à lire -> Sélection + clic sur icône # en mode d'édition -> Bouton Editer pour corriger
Merci

Épaf · 21 Octobre 2007

Re : Aide sur une boucle

Je viens de regarder ton code et j'ai deux questions : Où prends-tu le nom du client
Est-ce

'Dèfinit la varible C

ou Est-ce

'Boucle sur la plage R et MP
For Each R In MP
'Défintit la condition de la plage C
If R.Value = C Then

Avoue que tes commentaires n'aident pas bien le visiteur

@+

_Thierry · 21 Octobre 2007

Re : Aide sur une boucle

Bonjour Br44, MJ13, Epaf

Voilà mon interprétation, pour peu que j'ai bien interprété ...

Code:

Option Explicit
Const ClientA As String = "C18"
Const ClientB As String = "C19"
Const ClientC As String = "TOTO"
Const ClientD As String = "ZAZA"
'1-le N° de facture
'2-la date de Facture
'3-le montantant de la facture
Sub test()

Dim Chemin2 As String
Dim Wb4 As Workbook
Dim C As String
Dim MP As Range
Dim R As Range
Dim X As Byte

C = Workbooks("F.Xls").Sheets("Détail").Range("G3").Value
Chemin2 = "C:\RAPID\GESTION\Sc.XLS"
Set Wb4 = Workbooks.Open(Chemin2)
Set MP = Workbooks("SC.xls").Sheets(Mois).Range("A4:A" & Range("A65536").End(xlUp).Row)
    For Each R In MP
        If R.Value = C Then
        Select Case C
            Case ClientA, ClientB
                    With Wb2
                        With .Sheets("Facture")
                            .Range("C16").Copy
                            R.Offset(0, 3).PasteSpecial xlPasteValues
                            .Range("F12").Copy
                            R.Offset(0, 4).PasteSpecial xlPasteValues
                            .Range("G39").Copy
                            R.Offset(0, 5).PasteSpecial xlPasteValues
                        End With
                                For X = 1 To 2
                                    With .Sheets("Annexfacture" & X)
                                        .Range("C16").Copy
                                        R.Offset(X, 3).PasteSpecial xlPasteValues
                                        .Range("F12").Copy
                                        R.Offset(X, 4).PasteSpecial xlPasteValues
                                        .Range("G38").Copy
                                        R.Offset(X, 5).PasteSpecial xlPasteValues
                                    End With
                                 Next X
                          
                    End With
                    
            Case ClientC, ClientD
            
                    'With Wb2....
                            'TES AUTRES RETOURS
                    'End With
                    
                    
            Case Else 'POUR LES AUTRES CLIENTS
                    With Wb2.Sheets("Facture")
                         .Range("C16").Copy
                         R.Offset(0, 3).PasteSpecial xlPasteValues
                         .Range("F12").Copy
                         R.Offset(0, 4).PasteSpecial xlPasteValues
                         .Range("G39").Copy
                         R.Offset(0, 5).PasteSpecial xlPasteValues
                    End With
            End Select
       
       Exit For
       End If
    Next R
Application.CutCopyMode = False
Wb4.Save
Wb4.Close
End Sub

Bon Dimanche

@+Thierry

br44 · 21 Octobre 2007

Re : Aide sur une boucle

re:Bonjour MJ13,Epaf,Thierry et le forum

Grand merci à vous trois pour votre rapidité .

Mj13 : Désolé pour ne pas avoir joint de fichier mais celui-çi est rop lourd pour être joint .

Epaf : pour répondre à ta question ,Oui c'est bien la varible "C" qui regroupe l'ensemble des clients . il sagit donc isolé duex clients parmis l'enssemble.

Merçi pour l'astuce en se qui conserne le balisage , ne connaissant pas la procédure je ne pouvais l'exécuter .

Thierry: je test ta proposition et te tient au courant en cas de problème . Pourrais tu svp me donner quelques explications de manière à comprendre la manip .

Je vous dis à plus à tous les trois et merçi encore pour le coup de main
Br44

br44 · 21 Octobre 2007

Re : Aide sur une boucle

Re:Rebonjour à tous ,

Thierry : J'ai essayer ta macros ,mais il y a un petit souci , un message d'erreur apparait :

Erreur de compliation: End Select sans Select ,ou End If sans If , mais je ne voit pas ou est le problème . Svp peut-tu regerder ta macros et dire d'où cela pourrait venir

A plus sur ce fil Br44

Épaf · 21 Octobre 2007

Re : Aide sur une boucle

Hello,
As-tu ajouté/modifié quelque chose au code de Thierry ?

_Thierry · 21 Octobre 2007

Re : Aide sur une boucle

Bonsoir Br44, Epaf, le Forum

Il est clair que dans ce genre de code, je n'ai pas fait de test dans la mesure où je ne vais pas re-construire des fichiers pour simuler ta situtation réelle.

En fait il me semble qu'en re-lecture du code Modifié que j'ai produit, tout semble visuellement en ordre comme suit :

Code:

    [SIZE=3][COLOR=darkgreen][B]For Each[/B][/COLOR][/SIZE] R In MP
        [B][SIZE=3][COLOR=red]If[/COLOR][/SIZE][/B] R.Value = C [SIZE=3][COLOR=red][B]Then[/B][/COLOR][/SIZE]
        [SIZE=3][COLOR=blue][B]Select Case[/B][/COLOR][/SIZE] C
            [SIZE=3][COLOR=blue][B]Case [/B][/COLOR][/SIZE]ClientA, ClientB
                    [SIZE=3][COLOR=purple][B]With Wb2[/B][/COLOR][/SIZE]
                        [COLOR=darkred][B]With .Sheets("Facture")[/B][/COLOR]
                            .Range("C16").Copy
                            R.Offset(0, 3).PasteSpecial xlPasteValues
                            .Range("F12").Copy
                            R.Offset(0, 4).PasteSpecial xlPasteValues
                            .Range("G39").Copy
                            R.Offset(0, 5).PasteSpecial xlPasteValues
                        [B][COLOR=darkred]End With[/COLOR][/B]
                                [SIZE=3][COLOR=darkorange][B]For X = 1 To 2[/B][/COLOR][/SIZE]
                                    [COLOR=sienna][B]With .Sheets("Annexfacture" & X)[/B][/COLOR]
                                        .Range("C16").Copy
                                        R.Offset(X, 3).PasteSpecial xlPasteValues
                                        .Range("F12").Copy
                                        R.Offset(X, 4).PasteSpecial xlPasteValues
                                        .Range("G38").Copy
                                        R.Offset(X, 5).PasteSpecial xlPasteValues
                                    [B][COLOR=sienna]End With[/COLOR][/B]
                                [SIZE=3][COLOR=darkorange][B] Next X[/B][/COLOR][/SIZE]
                          
                    [SIZE=3][COLOR=purple][B]End With[/B][/COLOR][/SIZE]
 
           [SIZE=3][COLOR=blue][B]Case[/B][/COLOR][/SIZE] ClientC, ClientD
 
                  [COLOR=darkgreen]  'With Wb2....[/COLOR]
[COLOR=darkgreen]                           'TES AUTRES RETOURS[/COLOR]
[COLOR=darkgreen]                   'End With[/COLOR]
                    
 
            [SIZE=3][COLOR=blue][B]Case Else[/B][/COLOR][/SIZE] 'POUR LES AUTRES CLIENTS
                    [COLOR=sienna][B]With Wb2.Sheets("Facture")[/B][/COLOR]
                         .Range("C16").Copy
                         R.Offset(0, 3).PasteSpecial xlPasteValues
                         .Range("F12").Copy
                         R.Offset(0, 4).PasteSpecial xlPasteValues
                         .Range("G39").Copy
                         R.Offset(0, 5).PasteSpecial xlPasteValues
                    [B][COLOR=sienna]End With[/COLOR][/B]
           [SIZE=3][COLOR=blue][B]End Select[/B][/COLOR][/SIZE]
 
       Exit For
       [SIZE=3][COLOR=red][B]End If[/B][/COLOR][/SIZE]
   [SIZE=3][COLOR=darkgreen][B]Next R[/B][/COLOR][/SIZE]

Par conséquent un message d'erreur de compilation "End Select sans Select ,ou End If sans If " ne provient pas des instructions telles qu'elles sont présentée ci-dessus, puisque tout "match"...

Parfois on peut aussi avoir ce message en cas d'ouverture d'un With sans End With, et le message VB un peu imprécisémemnt parle de If ou de Select...

Maintenant, à toi de scrupuleusement vérifier de la même manière, au cas où, tu peux aussi t'aider en mode "pas à pas" du débugueur (touche [F8])

Bon Courage et bonne nuit

@+Thierry

br44 · 22 Octobre 2007

Re : Aide sur une boucle

Re: bonjour le forum ,Épaf,Thierry

je suis pret à remettre ma macros sur le fil mais je n'est trouver les balises sur le forum ?
S'agit-il d'une obtion payante ?

J'attend donc un rèponses avant de poster ,si non je m'arrangerais autrement.

A plus BR44

Épaf · 22 Octobre 2007

Re : Aide sur une boucle

Pour baliser ton code ? Tu le sélectionnes + 1 clic sur l'icône #, icône que tu ne vois qu'en mode d'édition en "mode Avancé".
@+

br44 · 22 Octobre 2007

Re : Aide sur une boucle

re:rebojour à tous ,Épaf

voiçi un essais

en espèrant qu'il soit conculant

A toute suite pour la macro balisée

Br44

br44 · 22 Octobre 2007

Re : Aide sur une boucle

re: Salut à tous ,

Bon comme prèvue je vous mais la macros ajuster pour mes besoin :

'Déclare le Chemin2 vers "SC.xls"
Dim Chemin2 As String
'Déclare les variables ClientA et ClientB
Dim ClientA As String
Dim ClientB As String
'Dèclare la variable Wb4
Dim Wb4 As Workbook
'Declare la Variable C
Dim C As String
'Declare la Variable MP
Dim MP As Range
'Declare la Variable R
Dim R As Range
'Declare la Variable x
Dim X As Byte

'Dèfinit les varibles ClientA et ClentB
ClientA = "C16"
ClientB = "C17"
'Dèfinit la varible C
C = Workbooks("F.Xls").Sheets("Détail").Range("G3").Value
'Dèfinit la varible Chemin2
Chemin2 = "C:\RAPID\GESTION\Sc.XLS"
'Dèfinit la varaible Wb4
Set Wb4 = Workbooks.Open(Chemin2)
'Dèfinit la variable MP
Set MP = Workbooks("SC.xls").Sheets(MOIS).Range("A4:A" & Range("A65536").End(xlUp).Row)

'Boucle sur la plage R et MP

For Each R In MP
'Défintit la condition de la plage C
If R.Value = C Then 'Sélectionne les Cases C
Select Case C
Case ClientA 'Pour le client "C16"
With Wb2
With .Sheets("Facture")
.Range("C16").Copy
R.Offset(0, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(0, 4).PasteSpecial xlPasteValues
.Range("G39").Copy
R.Offset(0, 5).PasteSpecial xlPasteValues
End With
For X = 1 To 2
With .Sheets("AnnexFacture1" & X)
.Range("C16").Copy
R.Offset(X, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(X, 4).PasteSpecial xlPasteValues
.Range("G38").Copy
R.Offset(X, 5).PasteSpecial xlPasteValues
End With
With .Sheets("AnnexFacture2" & X)
.Range("C16").Copy
R.Offset(X, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(X, 4).PasteSpecial xlPasteValues
.Range("G38").Copy
R.Offset(X, 5).PasteSpecial xlPasteValues
End With
Next X
Range("A16:A18,B16:B18,C16:C18").MergeCells = False
Range("A16:A18,B16:B18,C16:C18").MergeCells = True
Rows("16:18").RowHeight = 14.25
End With

Case ClientB 'Pour le client :"C17" With Wb2
With .Sheets("Facture")
.Range("C16").Copy
R.Offset(0, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(0, 4).PasteSpecial xlPasteValues
.Range("G39").Copy
R.Offset(0, 5).PasteSpecial xlPasteValues
End With
For X = 1 To 2
With .Sheets("AnnexFacture1" & X)
.Range("C16").Copy
R.Offset(X, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(X, 4).PasteSpecial xlPasteValues
.Range("G38").Copy
R.Offset(X, 5).PasteSpecial xlPasteValues
End With
Next X
Range("A19:A20,B19:B20,C19:C20").MergeCells = False
Range("A19:A20,B19:B20,C19:C20").MergeCells = True
Rows("19:20").RowHeight = 21.37
End With

Case Else 'pour les autres clients
With Wb2
With .Sheets("Facture")
.Range("C16").Copy
R.Offset(0, 3).PasteSpecial xlPasteValues
.Range("F12").Copy
R.Offset(0, 4).PasteSpecial xlPasteValues
.Range("G39").Copy
R.Offset(0, 5).PasteSpecial xlPasteValues
End With

'Fin de selection
End Select
'Sortie de boucle
Exit For
'Fin de condition End If 'Sort de la plage
Next R

Application.CutCopyMode = False 'Enregistre les données du classeur "SC.XLS"
Wb4.Save
'Ferme le Classeur "SC.XLS"
Wb4.Close
'J'èfface la plage "B5:G27"
Sheets("Détail").Range("B5:G27").ClearContents
End Sub

A noter : la seul diffèrance est que les références clients ont changées :

"C16 au lieu de "C18"

"C17 au lieu de "C19"

Je n'est pris que deux "Cases" au lieu de quatre

voilà c'est tout si vous voyer où celà peut bloquer faite mois signes .

Dans cette attante je dis à bientôt sur se fil .
Br44

skoobi · 22 Octobre 2007

Re : Aide sur une boucle

br44 à dit:
re: Salut à tous ,

'Fin de condition End If 'Sort de la plage
Next R

Br44

Bonsoir le fil,
ton message d'erreur doit venir de là:
End If ce trouve dans le commentaire 'Fin de condition.

br44 · 22 Octobre 2007

Re : Aide sur une boucle

re: Bonsoir Skoobi , le forum

Oui j'ai vu que je n'avait omis de décaler le texe lorque j'ai fais le balisage ,mai il ètait trop tard pour le modifier . Don il bien lire :

'Fin de condition
End If
'Sort de la plage
Next R

Grand merci à toi pour ta rèponse et à bientôt sur se fil.
Br44

Effectuez une recherche sur Excel Downloads...

Aide sur une boucle

br44

XLDnaute Impliqué

MJ13

XLDnaute Barbatruc

Épaf

XLDnaute Occasionnel

Épaf

XLDnaute Occasionnel

_Thierry

XLDnaute Barbatruc

br44

XLDnaute Impliqué

br44

XLDnaute Impliqué

Épaf

XLDnaute Occasionnel

_Thierry

XLDnaute Barbatruc

br44

XLDnaute Impliqué

Épaf

XLDnaute Occasionnel

br44

XLDnaute Impliqué

br44

XLDnaute Impliqué

skoobi

XLDnaute Barbatruc

br44

XLDnaute Impliqué

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums