Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

chtico

XLDnaute Nouveau
Bonjour,

J'essaie de créer un formulaire de saisie de commandes clients, pour lesquels certaines ont une périodicité au mois, au trimestre ou à l'année.
J'aimerais que certains montants, quand le critère période est sur Trimestre, génèrent autant de lignes qu'il y a de trimestre entre mon mois de facturation et une fin de période à 5 ans, et que chaque ligne calcule le mois de correspondance.
Par contre quand le critère période est sur Aucun, une seule ligne doit être générée.
En espérant avoir exprimé convenablement ma problématique, quelqu'un peut-il m'apporter ses lumières, je sèche.
Merci
 

Pièces jointes

  • Test formulaire.xlsm
    50.9 KB · Affichages: 65
  • Test formulaire.xlsm
    50.9 KB · Affichages: 69
  • Test formulaire.xlsm
    50.9 KB · Affichages: 70

JNP

XLDnaute Barbatruc
Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour Chtico :),
A tester
Code:
Sub Macro1()
Dim CC As Byte, NL As Integer, PE As Byte, I As Integer
NL = Sheets("Suivi CA").Range("A" & Cells.Rows.Count).End(xlUp).Row
Select Case Sheets("Formulaire").Range("B12")
    Case "Aucune"
        PE = 0
    Case "Mois"
        PE = 1
    Case "Trimestre"
        PE = 3
    Case "Année"
        PE = 12
End Select
If PE = 0 Then
    For CC = 1 To 8
        Sheets("Suivi CA").Cells(NL + 1, CC) = Sheets("Formulaire").Range("B" & CC * 2 + 2)
    Next CC
Else
    For I = 1 To 60 / PE
        For CC = 1 To 8
            Sheets("Suivi CA").Cells(NL + 1, CC) = Sheets("Formulaire").Range("B" & CC * 2 + 2)
        Next CC
        If I > 1 Then
            Sheets("Suivi CA").Cells(NL + 1, 4) = DateAdd("m", PE, Sheets("Suivi CA").Cells(NL, 4))
        End If
        NL = NL + 1
    Next I
End If
End Sub
Bon courage :cool:
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour chtico,

Voici une proposition :

Code:
Sub Valider()
    Dim Tablo() As Variant
    Dim Periode As String
    Dim i As Integer
    Dim NbPaiements As Integer
    Dim rg As Range
    
    Periode = Sheets("Formulaire").Range("B12")
    
    Select Case Periode
        Case "Aucune": NbPaiements = 1
        Case "Année": NbPaiements = 5           '5 ans
        Case "Trimestre": NbPaiements = 20      '5 ans x 4 trimestres
        Case "Mois": NbPaiements = 60           '5 ans x 12 mois
    End Select
        
    ReDim Tablo(1 To NbPaiements, 1 To 8)

    With Sheets("Formulaire")
        'initialisation du tablo
        Tablo(1, 1) = .Range("B4")      'client
        Tablo(1, 2) = .Range("B6")      'produit
        Tablo(1, 3) = .Range("B8")      'montant facturé
        Tablo(1, 4) = .Range("B10")     'mois facturation
        Tablo(1, 5) = .Range("B12")     'périodicité
        Tablo(1, 6) = .Range("B14")     'statut
        Tablo(1, 7) = .Range("B16")     'montat achat sur CA HT
        Tablo(1, 8) = .Range("B18")     'mois commande achat sur CA HT
        
        If NbPaiements > 1 Then  'si plus que 1 paiement
            For i = 2 To UBound(Tablo, 1)
                Tablo(i, 1) = .Range("B4")
                Tablo(i, 2) = .Range("B6")
                Tablo(i, 3) = .Range("B8")
                Tablo(i, 4) = DateSerial(Year(Tablo(i - 1, 4)), Month(Tablo(i - 1, 4)) + 60 / NbPaiements, Day(Tablo(i - 1, 4)))
                Tablo(i, 5) = .Range("B12")
                Tablo(i, 6) = .Range("B14")
                Tablo(i, 7) = .Range("B16")
                Tablo(i, 8) = .Range("B18")
            Next i
        End If
    End With
        
    'Copier dans le suivi
    Set rg = Sheets("Suivi CA").Range("A65000").End(xlUp).Offset(1, 0)
    rg.Resize(NbPaiements, 8) = Tablo

End Sub


Edit : bonjour JNP ! :)

A+
 

chtico

XLDnaute Nouveau
Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Bonjour,

J'ai un souci, le code proposé par Grand Chaman fonctionne sur l'exemple donné, par contre dès que je l'utilise au sein de mon classeur en réel il me génère une Erreur 9 par rapport à un indice. Pourtant ma feuille "formulaire" est identique. Je n'arrive pas à identifier le problème.
Code:
Sub Macro1()

    Dim Tablo() As Variant
    Dim Periode As String
    Dim i As Integer
    Dim NbPaiements As Integer
    Dim rg As Range
   
    Periode = Sheets("Formulaire").Range("B12")
   
    Select Case Periode
        Case "Aucune": NbPaiements = 1
        Case "Année": NbPaiements = 5           '5 ans
        Case "Trimestre": NbPaiements = 20      '5 ans x 4 trimestres
        Case "Mois": NbPaiements = 60           '5 ans x 12 mois
    End Select
       
    ReDim Tablo(1 To NbPaiements, 1 To 10)

    With Sheets("Formulaire")
        'initialisation du tablo
        Tablo(1, 1) = .Range("B4")      'client
        Tablo(1, 2) = .Range("B6")      'produit
        Tablo(1, 3) = .Range("B8")      'montant facturé
        Tablo(1, 4) = .Range("B10")     'mois facturation
        Tablo(1, 5) = .Range("B12")     'périodicité
        Tablo(1, 6) = .Range("B14")     'statut
        Tablo(1, 7) = .Range("B16")     'montat achat sur CA HT
        Tablo(1, 8) = .Range("B18")     'mois commande achat sur CA HT
        Tablo(1, 9) = .Range("E6")     'Nb d'abt extranet
        Tablo(1, 10) = .Range("H6")     'Nb de licences
       
        If NbPaiements > 1 Then  'si plus que 1 paiement
            For i = 2 To UBound(Tablo, 1)
                Tablo(i, 1) = .Range("B4")
                Tablo(i, 2) = .Range("B6")
                Tablo(i, 3) = .Range("B8")
                Tablo(i, 4) = DateSerial(Year(Tablo(i - 1, 4)), Month(Tablo(i - 1, 4)) + 60 / NbPaiements, Day(Tablo(i - 1, 4)))
                Tablo(i, 5) = .Range("B12")
                Tablo(i, 6) = .Range("B14")
                Tablo(i, 7) = .Range("B16")
                Tablo(i, 8) = .Range("B18")
                Tablo(1, 9) = .Range("E6")
                Tablo(1, 10) = .Range("H6")
                
              Next i
        End If
    End With
       
    'Copier dans le suivi
    Set rg = Sheets("Suivi CA").Range("A65000").End(xlUp).Offset(1, 0)
    rg.Resize(NbPaiements, 8) = Tablo

End Sub

L'erreur pointe sur ReDim Tablo(1 To NbPaiements, 1 To 10)

Help
 

chtico

XLDnaute Nouveau
Re : Générer des lignes actualisées (mois) sur enregistrement montant et périodicité

Rebonjour,

J'ai solutionné le pb en basculant sur le code de JNP.
Je n'ai pas trouvé la raison du pb (peut-être un conflit entre 2 macros sensiblement identiques sur le même classeur ?).

Salut
 

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 842
dernier inscrit
seb0390