XL 2021 Intégrations de multi données dans une cellule

100kibou

XLDnaute Nouveau
Bonjour à toutes et tous.
Voici mon nouveau problème dans excel:
dans une base de données je dois intégrer divers éléments
Je me sers d'un formulaire, dans le formulaire il y a un bouton qui ouvre un sous-formulaire avec 4 champs.
Le premier champ est obligatoire, les 3 suivants sont optionnels, on peut saisir soit les 4 champs ou bien 1 seul ou 2 ou 3.

Je que je n'arrive pas à faire, lorsqu'il n'y a que le premier la donnée s'integre bien dans ma BD.
Mais je n'arrive pas à faire cohabiter les autres champs dans la même cellule de la BD.
Je souhaite intégrer dans la même cellule avec une mise en forme (exemple dans le fichier) tous les champs remplis depuis le sous formulaire.
Je ne sais pas si cela est possible depuis vba.
Je vous joins un petit fichier avec mes bouts de code récupérer de ci et là.
Je vous souhaite une excellente soirée.
Cdlt
 

Pièces jointes

  • sous formulaire.xlsm
    28.7 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
Bonjour

essaie ceci
VB:
Private Sub btnvalider_Click()
'on verifie que le champ numero1 est rempli.
    If Len(Me.txtnum1) = 0 Then
        Me.lblmessagenumero = "Veuillez remplir ce champ obligatoir. Merci"
        Me.txtnum1.SetFocus
        Exit Sub
    End If
    If (Not IsNumeric(Me.txtnum1) And Me.txtnum1 <> "") Or (Not IsNumeric(Me.txtnum2) And Me.txtnum2 <> "") Or (Not IsNumeric(Me.txtnum3) And Me.txtnum3 <> "") Or (Not IsNumeric(Me.txtnum4) And Me.txtnum4 <> "") Then
        Me.lblmessagenumero = "Veuillez ne saisir que des nombres. Merci"
        Exit Sub
    End If
'on sauvegarde dans la source
    'on ajoute une ligne
    With Feuil1.ListObjects("TSource")
        .ListRows.Add
        Lastline = .ListRows.Count
        Resultat = Format(Me.txtnum1, "0000000") & IIf(Me.txtnum2 <> "", Chr(10), "") & Format(Me.txtnum2, "0000000") & IIf(Me.txtnum3 <> "", Chr(10), "") & Format(Me.txtnum3, "0000000") & IIf(Me.txtnum4 <> "", Chr(10), "") & Format(Me.txtnum4, "0000000")
        .DataBodyRange(Lastline) = Resultat
    End With
    
'procedure pour fermer le formulaire
Call btnfermer_Click

End Sub
 

100kibou

XLDnaute Nouveau
Bonjour

essaie ceci
VB:
Private Sub btnvalider_Click()
'on verifie que le champ numero1 est rempli.
    If Len(Me.txtnum1) = 0 Then
        Me.lblmessagenumero = "Veuillez remplir ce champ obligatoir. Merci"
        Me.txtnum1.SetFocus
        Exit Sub
    End If
    If (Not IsNumeric(Me.txtnum1) And Me.txtnum1 <> "") Or (Not IsNumeric(Me.txtnum2) And Me.txtnum2 <> "") Or (Not IsNumeric(Me.txtnum3) And Me.txtnum3 <> "") Or (Not IsNumeric(Me.txtnum4) And Me.txtnum4 <> "") Then
        Me.lblmessagenumero = "Veuillez ne saisir que des nombres. Merci"
        Exit Sub
    End If
'on sauvegarde dans la source
    'on ajoute une ligne
    With Feuil1.ListObjects("TSource")
        .ListRows.Add
        Lastline = .ListRows.Count
        Resultat = Format(Me.txtnum1, "0000000") & IIf(Me.txtnum2 <> "", Chr(10), "") & Format(Me.txtnum2, "0000000") & IIf(Me.txtnum3 <> "", Chr(10), "") & Format(Me.txtnum3, "0000000") & IIf(Me.txtnum4 <> "", Chr(10), "") & Format(Me.txtnum4, "0000000")
        .DataBodyRange(Lastline) = Resultat
    End With
   
'procedure pour fermer le formulaire
Call btnfermer_Click

End Sub
Hello VGENDRON
Tout d'abord un grand merci pour ce code.
Je viens de tester et cela fonctionne presque parfaitement.
Je rencontre le problème suivant lorsque plusieurs champs sont remplis tout fonctionne parfaitement avec la mise en forme adéquat.
Le problème que je rencontre c'est lorsque je ne rempli que le premier champ qui est obligatoire, il me renvoie "vrai" dans la cellule.
Le format est bon alors je ne vois pas d'ou cela vient.
Je te remts le fichier
Cdlt
 

Pièces jointes

  • Test_Cumul1.xlsx
    10.8 KB · Affichages: 3

Discussions similaires