Autres Formulaire vba

stellamaris

XLDnaute Nouveau
Bonjour,
Je me forme tout seul et je suis loin (de France je veux dire). Et je ne sais pas à quel endroit poser ma question...
Alors j'ai ouvert une discussion bien que le sujet soit largement traité.
J'ai pris ici et là des bouts de code parce que je ne sais pas faire...
J'ai une base clients que je voudrais remplir avec un formulaire
Je me suis inspiré d'un exemple mais je n'arrive pas à l'adapter. Ca fait presque 2 jours que je tourne !
Alors je me résous à poster mon fichier. Si quelqu'un peut mettre le bon code qui va avec le formulaire que j'ai fait, ça me sauverait.
Les réponses dans le formulaire sont décalées en lignes et en colonnes et je n'ai pas toutes les box qui marchent
C'est un Excel 2007 plus tout jeune comme celui qui s'en sert !!
Merci à tous, bien cordialement
Jean
 

Pièces jointes

  • juste la base.xlsm
    91.2 KB · Affichages: 37

Dudu2

XLDnaute Barbatruc
J'adore ce rose bonbon du UserForm. Mais bon, si ça pouvait être changé en autre chose... :cool:
1622466385431.gif
 

soan

XLDnaute Barbatruc
Inactif
@Jean

merci pour la petite histoire sur l'Inde, la coopérative agricole, et l'ONG ! 👍 vous êtes tous bien courageux pour faire ce qu'il faut après les conséquences catastrophiques du Tsunami ! bravo !!! 🏆 🥇


une fois, j'avais joué à ce très bon jeu PC :

Image 1.jpg


à gauche, c'est la jaquette ; à droite, c'est la 1ère énigme du jeu : il faut déplacer les rectangles qui "flottent dans l'air" pour reconstituer un texte juste à l'aide du graphisme des lettres ; donc c'est tout à fait possible même sans connaître la langue de l'écriture ; ci-dessous, un court résumé du jeu :

Image 2.jpg



ton fichier en retour. :) j'ai oublié de te parler d'une chose très importante :

affiche le formulaire, et mettons que tu veux saisir un nouveau client, dont le code est C21-03 ; donc pour Customer ID, tu saisis « C » ➯ affichage de « C21-01 » ; tape 2 pui 1 et tiret « - » ➯ idem : même affichage « C21-01 », et dessous, y'a les données correspondant à ce code client : c'est normal ; maintenant, tape 3 ➯ affichage de « C21-01 », mais les données en dessous n'ont pas changé ! elles correspondent toujours au code « C21-01 » mais ne correspondent pas à « C21-03 » ; ne t'en préoccupe pas ! appuie sur la touche TAB pour passer au champ suivant qui est la liste déroulante de Category, et aussitôt, la sortie du champ Customer ID fait que comme « C21-03 » n'existe pas encore dans la base de données, ça efface tous les champs du formulaire, sauf bien sûr celui que tu viens de saisir : « C21-03 » reste affiché. 😊

à un moment donné, j'ai pensé faire le même effacement juste avant que tu appuies sur TAB et quand tu tapes le 3 ; car déjà, ça pourrait voir que c'est un code inexistant dans la base, donc un nouveau code ; j'ai préféré ne pas utiliser cette méthode, car comme les données de « C21-01 » sont affichées, tu as ce choix : soit tu fais TAB si tu veux aucune de ces données, et ça fera comme au paragraphe ci-dessus ; soit : a) tu gardes les données identiques qui t'intéressent (par exemple la ville) ; b) tu modifies les données qui changent légèrement ; c) tu effaces les données inutiles qui ne te servent pas.​



@Dudu2 : c'est pas moi qui ai choisi la couleur rose du UserForm ! 😁 😛

mais prends-le du bon côté : c'est pour voir la vie en rose ! 😄 😂 🤣


soan
 

Pièces jointes

  • base-clients-facturation-macro.xlsm
    163.1 KB · Affichages: 5

stellamaris

XLDnaute Nouveau
Bonjour
Bonjour Jean (et Stella), le fil,

j'espère que t'es plus en Inde, ni cerné par le COVID ! 😜 mets bien ta protection ! 😷 j'sais pas trop si Stella est ta secrétaire ou ta femme ! 😂 p't'être les 2 en même temps ? (c'est pas incompatible !) ; ça s'ra mieux si elle aussi met le masque ! 😷

ton fichier en retour. :) il y a 2 feuilles car j'ai ajouté la feuille "Quotation SF". (j'suppose que tu devines pourquoi, n'est-ce pas ? 😉) ; sur la feuille "Customer base", j'ai supprimé toutes les lignes vides de ton tableau structuré (ListObject) car un tel tableau ne doit pas avoir de ligne vide ! même mes lignes 6 à 8 ne sont pas correctes car je n'ai mis que la 1ère donnée Customer ID (le reste à droite est vide car je n'ai pas voulu saisir beaucoup de données) ; j'ai fait cela seulement pour que tu puisses voir dans UserForm1, pour le champ "Customer ID", que la liste déroulante contient uniquement les 4 items des 4 codes client, et rien d'autre ! 🙂

je te laisse tout tester en profondeur ; j'ai testé de mon côté ; les 3 boutons de commande de UserForm1 marchent très bien ! 😊



tout ce qui suit concerne le code VBA.

j'ai supprimé ton module de classe vide (donc inutile) nommé Classe1 ; idem pour tes 2 modules standards Module1 et Module2 ; j'ai ensuite renommé Module3 en Module1 ➯ maint'nant, tout le code VBA est dans ThisWorkbook ; le nouveau Module1 ; et le module de UserForm1 ; ça allège, hein ? 😄

regarde partout, car j'ai tout modifié, y compris le formulaire UserForm1 (présentation, changement du type inadéquat de certains contrôles, ajout de 2 contrôles manquants, noms de certains contrôles, ordre de tabulation, etc...).


Module de UserForm1 (110 lignes) :
VB:
Option Explicit

Private Sub ClrUF()
  Dim i As Byte: Application.ScreenUpdating = 0
  For i = 1 To 18
    Controls("TextBox" & Format(i, "00")) = ""
  Next i
  For i = 2 To 7
    Controls("ComboBox" & i) = ""
  Next i
End Sub

Private Sub ComboBox1_Change() 'quand le Code client change
  If ComboBox1 = "" Then ClrUF: Exit Sub
  If ComboBox1.ListIndex = -1 Then Exit Sub
  Dim d$, lig&, k As Byte, i As Byte
  lig = ComboBox1.ListIndex + 5: Application.ScreenUpdating = 0
  For i = 1 To 16
    k = i + 2 - 3 * (i > 13)
    Controls("TextBox" & Format(i, "00")) = Cells(lig, k)
  Next i
  d = Cells(lig, 23) * 100: k = Val(d): If k > 0 Then TextBox17 = k & "%"
  TextBox18 = Cells(lig, 25)
  For i = 2 To 7
    k = i - 13 * (i > 2) - 3 * (i > 5) - (i = 7)
    Controls("ComboBox" & i) = Cells(lig, k)
  Next i
End Sub

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  If KeyAscii = 27 Then ClrUF
End Sub

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  Dim cel As Range, chn$: chn = ComboBox1: If chn = "" Then Exit Sub
  Set cel = Columns(1).Find(chn, , -4163, 1, 1): If cel Is Nothing Then ClrUF
End Sub

Private Function GD(chn$) As Variant 'GetDate
  If Not IsDate(chn) Then GD = "" Else GD = CDate(chn)
End Function

Private Function GP(chn$) As Variant 'GetPourcentage
  If Not IsNumeric(chn) Then GP = "" _
    Else GP = Int(Val(Replace$(chn, ",", "."))) / 100
End Function

Private Sub WriteContact(lig&)
  With Cells(lig, 1)
    .Value = ComboBox1             'Customer ID
    .Offset(, 1) = ComboBox2       'Category
    .Offset(, 2) = TextBox01       'Company
    .Offset(, 3) = TextBox02       'First name/Prénom
    .Offset(, 4) = TextBox03       'Last name/Nom
    .Offset(, 5) = TextBox04       'Address
    .Offset(, 6) = TextBox05       'Zip
    .Offset(, 7) = TextBox06       'City
    .Offset(, 8) = TextBox07       'State
    .Offset(, 9) = TextBox08       'Country
    .Offset(, 10) = TextBox09      'Phone
    .Offset(, 11) = TextBox10      'Cell
    .Offset(, 12) = TextBox11      'Website
    .Offset(, 13) = TextBox12      'E-mail
    .Offset(, 14) = GD(TextBox13)  'Contact Date
    .Offset(, 15) = ComboBox3      'Origin
    .Offset(, 16) = ComboBox4      'Product category
    .Offset(, 17) = ComboBox5      'Action done
    .Offset(, 18) = GD(TextBox14)  'When done
    .Offset(, 19) = TextBox15      'Action to be done
    .Offset(, 20) = GD(TextBox16)  'No later than
    .Offset(, 21) = ComboBox6      'Type
    .Offset(, 22) = GP(TextBox17)  'Discount
    .Offset(, 23) = ComboBox7      'Vaigah/SFT
    .Offset(, 24) = TextBox18      'Comments
  End With
  Application.ScreenUpdating = -1
End Sub

Private Sub cmdNew_Click() 'bouton Nouveau contact
  If MsgBox("Confirmez-vous l'insertion de ce nouveau contact ?", vbYesNo, _
    "Demande de confirmation d'ajout") <> vbYes Then Exit Sub
  WriteContact Cells(Rows.Count, 1).End(3).Row + 1
End Sub

Private Sub cmdModif_Click() 'bouton Modifier
  If MsgBox("Confirmez-vous la modification de ce contact ?", vbYesNo, _
    "Demande de confirmation de modification") <> vbYes Then Exit Sub
  If ComboBox1.ListIndex <> -1 Then WriteContact ComboBox1.ListIndex + 5
End Sub

Private Sub cmdQuit_Click() 'bouton Quitter
  Unload Me
End Sub

Private Sub UserForm_Initialize() 'initialisation du formulaire
  Dim T, n&
  With ActiveSheet.ListObjects("Customers")
    If Not .DataBodyRange Is Nothing Then
      n = .ListRows.Count: T = [A5].Resize(n): ComboBox1.List = T 'Customer ID
    End If
  End With
  ComboBox2.List = Array("Customer", "Prospect") 'Category
  ComboBox3.List = Array("Google", "Website", "Advertising", "Friends", "Hacked") 'Origin
  ComboBox4.List = Array("Moringa", "Soaps", "Honey", "Areca", "Bamboo") 'Product category
  ComboBox5.List = Array("Quotation", "Samples", "Brochure", _
    "Informations requested", "Mail", "Letter", "Phone call") 'Action done
  ComboBox6.List = Array("Individual", "Profesional") 'Type
  ComboBox7.List = Array("VAIGAH", "SFT") 'Vaigah / SFT
End Sub


Module1 :
VB:
Sub lancerFormulaire()
  If ActiveSheet.Name = "Customer base" Then UserForm1.Show
End Sub

note que UserForm1 est affiché uniquement si la feuille active est "Customer base" ! c'est pour ça que je n'ai pas eu besoin d'utiliser ta variable Ws (que j'ai supprimée) : le code VBA de UserForm1 utilise les contrôles de ce formulaire et les cellules d'une feuille de calcul ; ces cellules étant sans référence de feuille explicite, c'est donc implicitement les cellules de la feuille active qui est : "Customer base".


Module de ThisWorkbook :
VB:
Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim C As Range, test As Boolean
  'écrire devant Cancel = True pour tester sans imprimer, à supprimer pour imprimer
  Set C = ['Quotation SF'!H1] 'nom de la feuille à adapter
  test = C Like "N ###/##/####" And Format(Month(Date), "00") = Mid$(C, 7, 2) And Year(Date) = Val(Mid$(C, 10, 4))
  C = IIf(test, "N " & Format(Val(Mid$(C, 3, 3)) + 1, "000") & Mid$(C, 6, 99), "N 001/" & Format(Date, "mm/yyyy") & "")
End Sub

j'ai fait des petites modifs minimes dans cette sub ; à toi de tester à partir de la feuille "Quotation SF" ; pour moi c'est ok : les valeurs en H1 sont correctes. 😊 (code initial de départ « N 001/05/2021 » ; puis tous les codes suivants : "N 002/05/2021", "N 003/05/2021", "N 004/05/2021", etc...) ; rappel : cette sub est appelée juste avant impression : fais Ctrl p ; vérifie le code affiché en H1 ; puis appuie sur la touche Echap (ou clic / bouton Annuler) pour annuler l'impression et éviter un gaspillage inutile de papier : c'est plus écologique, et ça préserve la Planète et l'Environnement ! 🥳


si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis. 😉

soan​
Soan, je suis Jean en Inde. J'ai résolu le problème, très basiquement en important toutes mes feuilles dans ta base qui du coup est devenu l'outil de travail. Donc ça marche parfait et j'aurais jamais su faire ça; merci encore
Jean
 

Dranreb

XLDnaute Barbatruc
Je le re-joins dans son état actuel car j'y ai rajouté un positionnement des contrôles en fonction de la languen mais pas les contrôles manquants.

*** Pièce joint supprimée, refaite plus loin ***
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bon, j'ai ajouté les deux contrôles manquant.
Il reste quelques questions à se poser :
— Quelles sont exactement les ComboBox à liste dynamiques établies d'après ce que contient la base, non modifiables sur une ligne existante, à confier à CLs ? Je suis étonné que les info Company, Fisrst name et Last name n'en soient pas.
— Quelles sont les ComboBox à liste fixes, de valeur modifiable sur une ligne existante, à confier à CAs, et où sont ces listes ? Je doute un peu que les autres ComboBox plus bas doivent être confiées à CLs, mais comme je n'avais vu nulle part de liste fixe à leur appliquer …
 

Pièces jointes

  • CLsCAsStellamaris.xlsm
    185.6 KB · Affichages: 3

Discussions similaires

Réponses
4
Affichages
364

Statistiques des forums

Discussions
312 325
Messages
2 087 306
Membres
103 513
dernier inscrit
adel.01.01.80.19