Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2997 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  problème de boucle sur vba

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

problème de boucle sur vba

n°1476956
GOCK
Posté le 17-11-2006 à 08:38:58  profilanswer
 

bonjour
 
j'ai un petit soucis sur le code visual basic suivant
ce code concerne la gestion d'une facture, son enregistrement, sa consultation sur excel
 
il y a 3 onglets: facture - voir facture - listingv
 
voici le code pour l'enregiostrement:
Sub enregistrerlafacture()
'
'
myyear = Year(Range("G1" ))
 
ActiveSheet.Unprotect
Worksheets("listingV" ).Select
 
couryear = Year(Now)
If myyear = couryear Then GoTo suite Else MsgBox ("ATTENTION! bien vérifier d'avoir rentré la date correspondant à l'année en cours au format jj/mm/aaaa !" )
Range("G1" ).ClearContents
Exit Sub
suite:
 
Style = vbOKCancel
Reponse = MsgBox("As-tu bien tout vérifié, parce qu'après c'est plus compliqué de modifier (il faut aller dans le listing). Si c'est bon, clique sur OK ", Style)
If Reponse = vbCancel Then Exit Sub
 
ActiveSheet.Unprotect
Worksheets("listingV" ).Select
Worksheets("listingV" ).Rows(10).Select
Selection.Insert
 
Range("A10:DC10" ).Select
With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlGray16
        .PatternColorIndex = 37
        With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With
 
 
 
Range("A10" ).Select
Range("A10" ).Formula = "=MAX(A11:A5006)+1"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Range("A7" ).Select
 
    'Coordonnées:
    Range("B10" ).Formula = "=facture!G1"
    Range("A10" ).Formula = "=facture!A13"
    Range("C10" ).Formula = "=facture!A10"
    Range("D10" ).Formula = "=facture!E4"
    Range("E10" ).Formula = "=facture!E5"
    Range("F10" ).Formula = "=facture!E6"
    Range("G10" ).Formula = "=facture!F6"
     
    'Produit 1
    Range("H10" ).Formula = "=facture!A16"
    Range("I10" ).Formula = "=facture!B16"
    Range("J10" ).Formula = "=facture!C16"
    Range("K10" ).Formula = "=facture!D16"
    Range("L10" ).Formula = "=facture!E16"
    Range("M10" ).Formula = "=facture!F16"
    Range("N10" ).Formula = "=facture!G16"
     
    'Produit 2
    Range("O10" ).Formula = "=facture!A17"
    Range("P10" ).Formula = "=facture!B17"
    Range("Q10" ).Formula = "=facture!C17"
    Range("R10" ).Formula = "=facture!D17"
    Range("S10" ).Formula = "=facture!E17"
    Range("T10" ).Formula = "=facture!F17"
    Range("U10" ).Formula = "=facture!G17"
     
    ....    
     
     
    Rows("10:10" ).EntireRow.AutoFit
    Worksheets("listingV" ).Rows(10).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues
 
     
    Worksheets("facture" ).Range("a13" ).Formula = "=(listingV!A10)+1"
     
    madate = Range("B10" )
    Range("IS10" ) = Month(madate) * 1.1
     
    ActiveSheet.Protect
Worksheets("listingV" ).Select
 
    'selectionne la feuille des commandes
    Worksheets("facture" ).Select
    Range("G1" ).Select
    Range("G1" ) = Now
     
    Range("A16:A56" ).ClearContents
    Range("B16:B56" ).ClearContents
     
     
    Range("A1" ).Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Exit Sub
Blème:
    MsgBox ("le date, c'est en chiffre STP, Pas en charabia!" )
    Exit Sub
End Sub

 
code pour afficher les facture d'un mois donné:
la partie qui pose poblème est en rouge
en fait ce qui se passe, c'est que après loop while, le code boucle à a+1, même si la variable ladate est différente de firstadress ou égale à 0, donc elle boucle en permanence sans jamais s'arrêter
comment faire pour l'arrêter de boucler ?
merci

Sub RelevéFactures()
 
monmois = InputBox("mois choisi  (en chifre - janvier=1, février=2, etc...)" )
 
If monmois = "" Then Exit Sub
If monmois > 12 Then Exit Sub
Range("c10" ) = Choose(monmois, "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE" )
monannee = InputBox("veuillez rentrer l'année" )
 
Range("a16:c56" ).Select
Selection.ClearContents
Range("a8" ).Select
With Worksheets("listingv" ).Range("IS10:IS5048" )
    Set ladate = .Find(monmois * 1.1, LookIn:=xlValues)
    If Not ladate Is Nothing Then
        firstaddress = ladate.Address
        Do
        a = a + 1
        Cells(a + 15, 1) = ladate.Offset(0, -251)
        Cells(a + 15, 2) = "COMMANDE"
         
        Cells(a + 15, 3) = ladate.Offset(0, 1)
        Set ladate = .FindNext(ladate)
    Loop While Not ladate Is Nothing And ladate.Address <> firstAdress

    Cells(15 + monmois, 6) = Range("c58" )
    If Range("c58" ) <> Range("C" ) Then MsgBox ("attention" )
    End If


Message édité par GOCK le 17-11-2006 à 09:44:32
mood
Publicité
Posté le 17-11-2006 à 08:38:58  profilanswer
 

n°1477110
jpcheck
Pioupiou
Posté le 17-11-2006 à 11:12:09  profilanswer
 

ton do while not avec un is nothing ne me plait que très moyennement, mets des parentheses ou change la condition de sortie de boucle.

n°1477311
galopin01
Posté le 17-11-2006 à 14:04:40  profilanswer
 

bonjour gock, jpcheck,
 
Un petit coup de Option Explicit te donnerait la solution :
 
If Not ladate Is Nothing Then  
        firstaddress = ladate.Address  
...
Loop While Not ladate Is Nothing And ladate.Address <> firstAdress
firstAdress = "" il fallait mettre : . . . . . . . . . . . . . . . firstaddress
 
A+


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  problème de boucle sur vba

 

Sujets relatifs
probleme de boucle whileProbleme de boucle en perl
probleme de boucleproblème de boucle
problème de boucle/session : envoi de doublons en nombre variable ?!probleme affichage boucle
problème de variable en boucle arrivant d'un formulaireprobleme de double boucle et variables... [résolu]
probleme de boucleprobleme de boucle avec une date résolu
Plus de sujets relatifs à : problème de boucle sur vba


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR