Recup Donnees dans un tableau et automatisation d'un combobox

bonjour,

je vous reviens avec deux soucis

1. voir le fichier ci joint et retrouver qui code fonctionnait avant mais plus maintenant apres la suppression de la colonne F dans la feuille Grand Recu, avant les montants était bien inscrites comme les libelles et date; mais apres avoir delete la colonne, les montants ne sont plus recuperes.

2. dans le userform, je souhaiterais automatiser l'affichage des bornes de N° de recus dans les combobox 4 et 5 apres avoir taper la date, on cherche ces bornes dans Base_Licence et on les affiche dans les combobox.

merci de votre aide.

Bonsoir,

ci-jointe proposition

bonsoir Thev,

merci de ton intervention, le pb 2 est resolu

et le 1 pour la recup des données du tableau Base_licence pour la feuille Grand_reçu ne fonctionne pas, il n'y a plus de donnees qui saffiche dans la feuille Grrand_reçu

merveil00 a écrit :

pour la recup des données du tableau Base_licence pour la feuille Grand_reçu ne fonctionne pas, il n'y a plus de donnees qui saffiche dans la feuille Grrand_reçu

Cela est lié à votre base Licence et au format de votre colonne numéro de reçu. Cette colonne devrait être au format Texte et non au format standard. Le format standard fait que certains numéros de reçu sont interprétés comme du nombre et d'autres comme du texte dès qu'ils contiennent une lettre.

ci-jointe version avec colonne numéro de reçu corrigée

merci thev, ça marche très bien

bonjour Thev,

je reviens encore chaleureusement sur ce sujet avec le code ci dessous:

 Sub merv(A)

    Dim cell As Range, cell1 As Range
    Dim no_reçu As String

    With A
        Set cell = .Columns("B").Find(CDate(ComboBox6)): If cell Is Nothing Then Set cell = .Columns("B").Find(ComboBox6)
        If Not cell Is Nothing Then
             Set cell1 = cell
             Do
                no_reçu = .Cells(cell.Row, "A")
                ComboBox7.AddItem no_reçu: ComboBox8.AddItem no_reçu
                If ComboBox7 = "" Then ComboBox7 = no_reçu
                ComboBox8 = no_reçu
                Set cell = .Columns("B").Find(CDate(ComboBox6), after:=cell)
             Loop Until cell.Address = cell1.Address
        End If
    End With

End Sub

qui ne fonctionne plus actuellement et le debogage surligne la ligne

Loop Until cell.Address = cell1.Address

en jaune avec un message d'erreur ci joint dans la capture.

A noter que le constat est remarqué que lorsqu'on change de base de donnée, avec celle de la base_Licence (Feuil7) cela marche très bien.

j'ai pourtant bien veuillez à mettre les formats des colonnes comme sur la base de la Feuil7.

merci de votre aide.

A noter que le constat est remarqué que lorsqu'on change de base de donnée, avec celle de la base_Licence (Feuil7) cela marche très bien.

j'ai pourtant bien veuillez à mettre les formats des colonnes comme sur la base de la Feuil7.

merci de votre aide.

Bonjour,

Il y a des chances que cela provienne de la colonne "Date" de votre base de données. Certaines dates sont peut être enregistrées en texte. Pour le vérifier, mettre toute les dates de la colonne au format "Nombre". Si certaines n'apparaissent pas comme des nombres, alors cliquer sur chacune, puis appuyer sur la touche "Entrée", elles doivent alors apparaître comme des nombres.

Repasser après toutes les éléments de la colonnes au format "Date".

Essai concluant.....

le problème venait bien évidemment du format de ma colonne de date. merci de ta brillante orientation.

bonsoir thev,

je te reviens encore pour un souci sur le meme projet,

je souhaite alimenter 4 feuilles a partir de cette userform (image en pj) merci de voir mon code ci dessous qui beugue et s'arrete des la premiere ligne de 'alimenter la base de données Factures et d'apporter des améliorations.

Private Sub CommandButton4_Click()
     Dim Ws As Worksheet
     Dim V As Range
    'condition de remplissage de donnees

If MsgBox("Etes vous sur de charger ces données?", vbYesNo + vbExclamation + vbDefaultButton2, "Demande de confirmation") = vbNo Then
    Exit Sub

ElseIf Me.ComboBox6 = "" Or Me.ComboBox2 = "" Or Me.ComboBox7 = "" Or Me.ComboBox8 = "" Or Me.NumeroDemande = "" Or Me.TextBox11 = "" Then

        MsgBox "Veuillez remplir tous les champs", vbCritical, "Erreur"
        Exit Sub

Else
  'code pour alimenter la feuille base de données
    i = 2
    Do While Cells(i, 1) <> ""
        Cells(i, 1).Offset(1, 0).Select
        i = i + 1
    Loop

    ActiveCell.Value = Me.NumeroDemande.Value
    ActiveCell.Offset(0, 1).Value = CDate(Me.TextBox7.Value)
    ActiveCell.Offset(0, 2).Value = Right(Me.ComboBox8.Value, 3) - Right(Me.ComboBox7.Value, 3) + 1
    ActiveCell.Offset(0, 3).Value = CDate(Me.ComboBox6.Value)
    ActiveCell.Offset(0, 4).Value = "De " & Me.ComboBox7.Value & " à " & Me.ComboBox8.Value
    ActiveCell.Offset(0, 5).Value = Me.ComboBox2.Value
    ActiveCell.Offset(0, 6).Value = CDec(Me.TextBox11.Value)

'alimenter la base de données Factures
    Set Ws = Sheets("Base_de_donnees_2").Select

         i = 2
    Do While Cells(i, 1) <> ""
        Cells(i, 1).Offset(1, 0).Select
        i = i + 1
    Loop

    ActiveCell.Value = Me.TextBox14.Value
    ActiveCell.Offset(0, 1).Value = CDate(Me.TextBox7.Value)
    ActiveCell.Offset(0, 2).Value = Right(Me.ComboBox11.Value, 3) - Right(Me.ComboBox12.Value, 3) + 1
    ActiveCell.Offset(0, 3).Value = CDate(Me.ComboBox6.Value)
    ActiveCell.Offset(0, 4).Value = "De " & Me.ComboBox11.Value & " à " & Me.ComboBox12.Value
    ActiveCell.Offset(0, 5).Value = Me.ComboBox2.Value
    ActiveCell.Offset(0, 6).Value = CDec(Me.TextBox15.Value)
'alimenter le grand recu
        Sheets("Grand Reçu").Select
        Set Ws = Sheets("Grand Reçu")

    Ws.Range("E7").Value = Me.NumeroDemande.Value
    Ws.Range("I5").Value = Me.TextBox12.Value
    Ws.Range("C11").Value = Me.ComboBox2.Value
    Ws.Range("F11").Value = Sheets("Base_de_donnees").Range("C" & (Sheets("Base_de_donnees").Range("B" & Rows.Count).End(xlUp).Row)).Value

'alimenter le tableau
    Ws.Range("B13:F250").ClearContents

    Ws.Range("B10").CurrentRegion.Offset(4, 0).ClearContents
    tablo = fb.Range("A3:E" & fb.Range("B" & Rows.Count).End(xlUp).Row)
    k = 0
    For i = 1 To UBound(tablo, 1)
        If CDate(tablo(i, 2)) = CDate(Me.ComboBox6) _
        And CStr(tablo(i, 1)) >= Me.ComboBox7 _
        And CStr(tablo(i, 1)) <= Me.ComboBox8 Then
            ReDim Preserve tabloR(1 To 5, 1 To k + 1)
            tabloR(1, k + 1) = k + 1
            tabloR(2, k + 1) = tablo(i, 1)
            tabloR(3, k + 1) = CDate(tablo(i, 2))
            tabloR(4, k + 1) = tablo(i, 4)
            tabloR(5, k + 1) = tablo(i, 5)
            k = k + 1
        End If

    Next i
'mise en forme libele grand reçu

'ecriture en dessous du reçu

Ws.Range("D" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 2).Value = "Total :"
Ws.Range("E" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 2).Value = Me.TextBox11.Value
Ws.Range("D" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 3).Value = "Soit une somme de " & chiffrelettre(Me.TextBox11.Value) & " Francs CFA."
Ws.Range("C" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 6).Value = "Mode de paiement : "
Ws.Range("D" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 6).Value = "Cash"

'mise en forme de la zone d'impression

Set V = Ws.Range("A1", "I" & (Ws.Range("B" & Rows.Count).End(xlUp).Row) + k + 11)
Ws.PageSetup.PrintArea = V.Address

    On Error Resume Next
    Range("B13").Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
    Erase tabloR

 End If
Sheets("Grand Reçu").Visible = xlSheetVisible
Unload Me

End Sub

merci d'avance de votre aide

Bonjour,

il serait plus simple de me communiquer la nouvelle version de votre fichier, ou du moins un extrait non confidentiel.

Essayer éventuellement ce code :

Private Sub CommandButton4_Click()
    Dim cell As Range, cell1 As Range, tb_reçus As Object, tb_reçu(), V As Range
    Dim n°_reçu As String, référence As String, date_reçu As Date, libellé As String, montant As Single

    'condition de remplissage de donnees
    If MsgBox("Etes vous sur de charger ces données?", vbYesNo + vbExclamation + vbDefaultButton2, "Demande de confirmation") = vbNo Then
        Exit Sub
    ElseIf Me.ComboBox6 = "" Or Me.ComboBox2 = "" Or Me.ComboBox7 = "" Or Me.ComboBox8 = "" Or Me.NumeroDemande = "" Or Me.TextBox11 = "" Then
            MsgBox "Veuillez remplir tous les champs", vbCritical, "Erreur"
            Exit Sub
    Else

      'code pour alimenter la feuille base de données
        With Sheets("Base_de_donnees")
            Set cell = .Columns("A").Find("")    'première cellule vide en colonne A de la feuille après ligne 1

            cell.Value = Me.NumeroDemande.Value
            cell.Offset(0, 1).Value = CDate(Me.TextBox7.Value)
            cell.Offset(0, 2).Value = Right(Me.ComboBox8.Value, 3) - Right(Me.ComboBox7.Value, 3) + 1
            cell.Offset(0, 3).Value = CDate(Me.ComboBox6.Value)
            cell.Offset(0, 4).Value = "De " & Me.ComboBox7.Value & " à " & Me.ComboBox8.Value
            cell.Offset(0, 5).Value = Me.ComboBox2.Value
            cell.Offset(0, 6).Value = CDec(Me.TextBox11.Value)
        End With

        'code pour alimenter la base de données Factures
        With Sheets("Base_de_donnees_2")
            Set cell = .Columns("A").Find("")    'première cellule vide en colonne A de la feuille après ligne 1

            cell.Value = Me.TextBox14.Value
            cell.Offset(0, 1).Value = CDate(Me.TextBox7.Value)
            cell.Offset(0, 2).Value = Right(Me.ComboBox11.Value, 3) - Right(Me.ComboBox12.Value, 3) + 1
            cell.Offset(0, 3).Value = CDate(Me.ComboBox6.Value)
            cell.Offset(0, 4).Value = "De " & Me.ComboBox11.Value & " à " & Me.ComboBox12.Value
            cell.Offset(0, 5).Value = Me.ComboBox2.Value
            cell.Offset(0, 6).Value = CDec(Me.TextBox15.Value)
        End With

        '// alimenter le grand reçu
        With Sheets("Grand Reçu")

            ' alimentation entête du grand reçu
            .Range("E7").Value = Me.NumeroDemande.Value
            .Range("I5").Value = Me.TextBox12.Value
            .Range("C11").Value = Me.ComboBox2.Value
            .Range("F11").Value = Right(Me.ComboBox8.Value, 3) - Right(Me.ComboBox7.Value, 3) + 1

            ' initialisation corps et bas du grand reçu
            .Range("B13:F250").ClearContents
            .Range("B10").CurrentRegion.Offset(4, 0).ClearContents

            ' Chargement tableau corps du grand reçu
            With Sheets("Base_Licence")
                Set tb_reçus = CreateObject("System.Collections.Arraylist")
                i = 0
                Set cell = .Columns("B").Find(CDate(Me.ComboBox6.Value))  'premier n° reçu dans la base licence pour la date sélectionnée
                If Not cell Is Nothing Then
                    Set cell1 = cell
                    Do
                        i = i + 1
                        n°_reçu = i: référence = cell.Offset(, -1): date_reçu = cell.Offset(, 0): libellé = cell.Offset(, 2): montant = cell.Offset(, 3)
                        tb_reçu = Array(n°_reçu, référence, date_reçu, libellé, montant): tb_reçus.Add tb_reçu
                        Set cell = .Columns("B").Find(CDate(Me.ComboBox6.Value), after:=cell)
                    Loop Until référence = Me.ComboBox8 Or cell.Address = cell1.Address
                End If
            End With

            ' alimentation corps du grand reçu
            .Range("B13").Resize(tb_reçus.Count, UBound(tb_reçu) + 1) = Application.Transpose(Application.Transpose(tb_reçus.toarray))

            ' alimentation bas du grand reçu
            .Range("D" & (.Range("B" & Rows.Count).End(xlUp).Row) + 2).Value = "Total :"
            .Range("E" & (.Range("B" & Rows.Count).End(xlUp).Row) + 2).Value = Me.TextBox11.Value
            .Range("D" & (.Range("B" & Rows.Count).End(xlUp).Row) + 3).Value = "Soit une somme de " & chiffrelettre(Me.TextBox11.Value) & " Francs CFA."
            .Range("C" & (.Range("B" & Rows.Count).End(xlUp).Row) + 6).Value = "Mode de paiement : "
            .Range("E" & (.Range("B" & Rows.Count).End(xlUp).Row) + 6).Value = "Cash"

            ' mise en forme de la zone d'impression
            Set V = .Range("A1", "I" & (.Range("B" & Rows.Count).End(xlUp).Row) + 11)
            .PageSetup.PrintArea = V.Address

            ' affichage feuille Grand Reçu
            .Visible = xlSheetVisible
        End With
    End If

    'déchargement formulaire
    Unload Me

End Sub

bonsoir Thev,

merci de ta reponse,

le code que tu as proposé alimente les deux feuilles de base de données mais pas le grand reçu;..... et cree un bug.

je te joins le fichier, je t'explique: nous allons avoir 2 bd qui vont etre alimentés a partir du meme userform qui eux puissent des infos resectivement dans les feuilles Base licence ou Base certificat (puis avec les terminaisons _2 pour la facture globale) pour Le grand reçu. une fois la bd renseignée nous devons dessortir un gd reçu et une facture globale.

Bonsoir,

ci-jointe nouvelle version

bonjour et bon dimanche a toi Thev,

merci de tes multiples interventions, je teste le fichier et tout marche tres bien ... sauf le bug qui ferme Excel lorsque je vais ouvrir le feuille FActure Globale apres avoir rempli le formulaire, tu as le meme constat??

Bonjour,

Je n'ai pas ce bug mais je n'ai pas non plus les liaisons qui existent avec ce fichier. Il se peut que le problème vienne de là.

pour ce fichier il n'existe pas de liaisons, tu peux les delete pour voir. les données dans toutes les feuilles sont indépendantes

j'ai delete les liaisons qui existaient, et jai plus de bug, c'est réglé

je vais pouvoir ajouter un formulaire qui va s'ouvrir après le clic sur le bouton valider pour permettre a l'utilisateur de selectionner le document Grand reçu ou facture, vu que là on reste sur la feuille base de données.

et ajouter quelques securites..... comme eviter d'ecrire des doublons dans la bd (surtout au niveau des dates avec le combobox6)

Bonjour,

J'ai enlevé les liaisons et pas de bug chez moi.

ci-jointe version sans liaisons

ci joint la nouvelle version avec la securite d'eviter les doublons de date dans le combobox6