Sujet Précédent Sujet Suivant

Boucle conditionnelle

Fermé
arca2001 Messages postés 7 Date d'inscription mercredi 17 janvier 2007 Statut Membre Dernière intervention 11 septembre 2016 - 10 juin 2016 à 00:36
arca2001 Messages postés 7 Date d'inscription mercredi 17 janvier 2007 Statut Membre Dernière intervention 11 septembre 2016 - 10 juin 2016 à 11:20
Bonjour,

j'ai réussi à créer le code joint. mais je n'obtient pas le bon résultat avec ma boucle qui inclut if. je voudrai qu'il utilise la deuxième macro uniquement si le montant de ma cellule en colonne 15 situe sur la même ligne que ma référence c est supérieur a zéro.

en fait il s'agit de créer une facture, en fonction du nombre de présence au cour, sachant que la liste des personne n est pas épurer chaque mois car on en a besoin pour autre chose. donc ceux non présent affiche zéro.

bref je m égare, j'aimerai que ma fonction if me créer uniquement un onglet pour les personnes présente au cour du mois.

c'est pas forcement super propre, si vous pouviez m'aider ce serai genial

d'avance merci de votre aide
arca 

Public nom, c

Sub facturation()

'selection onglet facturation
Sheets("FACT").Select

'designer elements utiles

Dim test
Dim dernligne As Long
Dim premligne As Long

'definir les premieres et dernieres ligne
premligne = 8
dernligne = Range("A8").End(xlDown).Row

'boucle pour chaque cellule non vide sur la premiere colonne a parti de a8
For Each c In Range(Cells(premligne, 1), Cells(dernligne, 1))

    'le nom = la valeur inscrite dans la cellule de la 1er colonne
    nom = c.Value
    'definir la valeur test
    test = Cells(c.Row, 15).Value
    
    'boucle faire tant que la cellule facturation est sup a 0
    'creation d'un nouvel onglet et le nommer au nom de l enfant
    If test > 0 Then Call creation_facture


Next

End Sub

Sub creation_facture()

'selection de l'onglet facturation

Sheets("FACT").Select
'nommer les elements utiles



Dim dernligne As Long
Dim premligne As Long

'definition de la premiere et derniere ligne

premligne = 8
dernligne = Range("A8").End(xlDown).Row


'le nom de l onglet = la valeur inscrite dans la cellule
    nom = c.Value

 
    'CREATION NOUVEL ONGLET

    Sheets.Add Count:=1, After:=Worksheets(Worksheets.Count)

    'nommer nouvel onglet selon element de la plage en colonne a

    ActiveSheet.Name = nom

    'copier le modele de facture
        Sheets("FACTURE").Select
        Range("A1:G35").Select
        Selection.Copy
        
     'selectionner le nouvel onglet et coller les cellule copiée
        Sheets(nom).Select
        
    'collage speciale en formule et mise en forme de la facture
    
        Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
            , SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
    
        'inscrire le nom de l'enfant qui correspond aussi au nom de l onglet en e7
        Range("E7:F7").Select
        Application.CutCopyMode = False
     
        ActiveCell.FormulaR1C1 = nom
          
        'adapter la mise en forme
            Application.CutCopyMode = False
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
        End With
        Application.PrintCommunication = True
        ActiveSheet.PageSetup.PrintArea = ""
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = 100
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With
        Application.PrintCommunication = True
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
        End With
        Application.PrintCommunication = True
        ActiveSheet.PageSetup.PrintArea = ""
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 0
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
            .EvenPage.LeftHeader.Text = ""
            .EvenPage.CenterHeader.Text = ""
            .EvenPage.RightHeader.Text = ""
            .EvenPage.LeftFooter.Text = ""
            .EvenPage.CenterFooter.Text = ""
            .EvenPage.RightFooter.Text = ""
            .FirstPage.LeftHeader.Text = ""
            .FirstPage.CenterHeader.Text = ""
            .FirstPage.RightHeader.Text = ""
            .FirstPage.LeftFooter.Text = ""
            .FirstPage.CenterFooter.Text = ""
            .FirstPage.RightFooter.Text = ""
        End With

     

 
 
End Sub







2 réponses

Réponse 1 / 2
jordane45 Messages postés 38314 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 24 novembre 2024 4 705
10 juin 2016 à 02:40
Bonjour,


Le code semble "correct" à l'exception qu'il serait judicieux de spécifier la feuille concernée à chaque fois... car si dans ta seconde macro tu ajoutes une nouvelle feuille... ton code ne pointe plus sur les bonnes cellules....

Donc un truc du genre : 

Dim sh As Worksheet
Dim rng As Range

Set sh = Sheets("FACT")
Set rng = sh.Range(Cells(premligne, 1), Cells(dernligne, 1))

For Each c In rng

    'le nom = la valeur inscrite dans la cellule de la 1er colonne
    nom = c.Value
    'definir la valeur test
    test = sh.Cells(c.Row, 15).Value
    
    'boucle faire tant que la cellule facturation est sup a 0
    'creation d'un nouvel onglet et le nommer au nom de l enfant
    If test > 0 Then Call creation_facture
Next


0
Réponse 2 / 2
arca2001 Messages postés 7 Date d'inscription mercredi 17 janvier 2007 Statut Membre Dernière intervention 11 septembre 2016
10 juin 2016 à 10:25
bonjour,

je te remercie pour ces informations utiles, mais je ne comprends toujours pas pourquoi ma formule if ne fonctionne pas correctement. as tu une idée?

quand je fais tourner la macro un seul onglet est créer
d'avance merci
cordialement
arca
0
jordane45 Messages postés 38314 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 24 novembre 2024 4 705
Modifié par jordane45 le 10/06/2016 à 10:59
COmmence par faire tourner la macro en mode pas à pas ... et regarde la valeur de ta variable.....


Au cas où ... ajoute un peu de débogage sous la ligne qui récupère la valeur... histoire de pouvoir voir le résultat dans la fenêtre d'exécution du VBE 
test = sh.Cells(c.Row, 15).Value
debug.print " c.row = " & c.Row & "   test = " & test 'affiche dans la fenêtre d'exécution
0
arca2001 Messages postés 7 Date d'inscription mercredi 17 janvier 2007 Statut Membre Dernière intervention 11 septembre 2016
10 juin 2016 à 11:20
ok merci je suis débutante en vba, j ai assimiler des truc mais me manque encore beaucoup de connaissance

je te remercie
0

Discussions similaires

Mon pc s'allume et s'éteint en boucle
Jack -
Daniel -

16 réponses
faire une boucle sans VBA
lucky-luccio -
lucky-luccio -

3 réponses
Boucle en Batch
Lord_Vking -
Foxyo -

22 réponses
tele s'eteind et s'allume en boucle
avion386 -
txiki -

4 réponses
Mise en forme conditionnelle d'un tableau - word
Ducoduc -
Raymond PENTIER -

1 réponse