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.
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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.
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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.
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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??
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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)
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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