Microsoft 365 Macro à corriger / utilisation d'un formulaire pour compléter un tableau

[ozone083]

Bonjour

En consultant Internet, j'ai réussi à trouver du code VBA permettant de créer un formulaire pour remplir un tableau excel (avec des colonnes définies).
Cependant lorsque je rentre mes données, j'obtiens un message d'erreur.....Et je ne comprends pas ce qui cloche (suis débutant en VBA). Une idée ?

Egalement j'ai fait un formulaire pour consulter cette base de données lorsqu'on précise un champ ; j'ai également ajouter un bouton "modify" pour modifier les données si on s'aperçoit qu'elles sont erronnées. Mais comme c'est la même macro que sur le formulaire Création, j'obtiens le même message d'erreur

Bref si vous pouviez m'aider, cela serait super

Un grand merci pour votre aide

Bonne soirée

 

[soan]

Bonjour ozone083,

ton fichier en retour ; à toi d'essayer tes 2 boutons du "Tableau de Bord". ​

module M1_OpenForm :

'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
' AFficher un formulaire à partir d'une feuille Excel
'****************************************************

Sub OpenKeyingForm()
  frmSaisie.Show
End Sub

Sub OpenSearchForm()
  frmRecherche.Show
End Sub

module de frmRecherche (56 lignes) :

Option Explicit

Private Sub CboTender_Change()
  Dim cel As Range: If CboTender = "" Then Exit Sub
  With Worksheets("SOURCE")
    .Select: [A1].Select: Application.ScreenUpdating = 0
    Set cel = .Columns(1).Find(CboTender, , -4163, 1, 1)
  End With
  If cel Is Nothing Then Exit Sub
  TextBOID = "": TextSegment = "": TextRegion = "": TextCountry = ""
  TextScope = "": TextDetailledScope = "": TextContractDuration = ""
  TextNTP = "": TextCAPEX = "": TextOPEX = ""
  With Cells(cel.Row, 1)
    TextBOID = .Offset(, 1)
    TextRegion = .Offset(, 2)
    TextCountry = .Offset(, 3)
    TextSegment = .Offset(, 4)
    TextScope = .Offset(, 5)
    TextDetailledScope = .Offset(, 6)
    TextContractDuration = .Offset(, 7)
    TextNTP = .Offset(, 8)
    TextCAPEX = Format(.Offset(, 9), "Currency")
    TextOPEX = Format(.Offset(, 10), "Currency")
  End With
End Sub

Private Sub BtnModify_Click()
  Dim cel As Range: If CboTender = "" Then Exit Sub
  With Worksheets("SOURCE")
    .Select: [A1].Select: Application.ScreenUpdating = 0
    Set cel = .Columns(1).Find(CboTender, , -4163, 1, 1)
  End With
  If cel Is Nothing Then Exit Sub
  With Cells(cel.Row, 1)
    .Offset(, 1) = TextBOID
    .Offset(, 2) = TextRegion
    .Offset(, 3) = TextCountry
    .Offset(, 4) = TextSegment
    .Offset(, 5) = TextScope
    .Offset(, 6) = TextDetailledScope
    .Offset(, 7) = TextContractDuration
    .Offset(, 8) = TextNTP
    .Offset(, 9) = TextCAPEX
    .Offset(, 10) = TextOPEX
  End With
  Application.ScreenUpdating = -1
End Sub

Private Sub BtnClose_Click()
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  LblMessage = "Please select the Tender Name in the database"
End Sub

module de frmSaisie (44 lignes) :

Option Explicit

Private Sub TxtTenderName_Change()
  'bouton saisie activé si données Nom TEnder
  BtnAdd.Enabled = (TxtTenderName <> "")
End Sub

Private Sub BtnAdd_Click() 'ajout de nouvelles infos dans la database
  Worksheets("SOURCE").Select: [A1].Select: Application.ScreenUpdating = 0
  Dim lig&: lig = Cells(Rows.Count, 1).End(3).Row + 1
  With Cells(lig, 1)
    .Value = TxtTenderName
    .Offset(, 1) = TxtBOID
    .Offset(, 2) = CboRegion
    .Offset(, 3) = TxtCountry
    .Offset(, 4) = CboSegment
    .Offset(, 5) = CboScope
    .Offset(, 6) = CboDetailledScope
    .Offset(, 7) = TxtContractDuration
    .Offset(, 8) = TxtNTP
    .Offset(, 9) = TxtCAPEX
    .Offset(, 10) = TxtOPEX
  End With
  Application.ScreenUpdating = -1
End Sub

Private Sub BtnDatabase_Click() 'va sur la base de données
  Worksheets("SOURCE").Select: [A1].Select
End Sub

Private Sub BtnErase_Click() 'efface tous les champs du formulaire
  TxtTenderName = "": TxtBOID = "": CboSegment = "": CboRegion = "": TxtCountry = ""
  CboScope = "": CboDetailledScope = "": TxtContractDuration = "": TxtNTP = ""
  TxtCAPEX = "": TxtOPEX = ""
End Sub

Private Sub BtnExit_Click() 'ferme le formulaire
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  LblMessage = "Please fill-up all the info, please"
End Sub

---

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

soan

 

[ozone083]

Bonjour Soan

Un énorme merci, je vais donc modifier le code en conséquence.

Si je puis me permettre, il faudrait que je fasse une autre modification
En effet, dans Detailled Scope, il faut que je puisse choisir plusieurs valeurs et non pas une seule
je crois que Combox ne permet pas de faire un choix multiple, il faudrait faire un ListeBox. Est ce exact ?

Mais du coup comment adapter le code pour que suivant la valeur de Scope, il affiche la liste Detailled Scope et qu'un choix multiple puisse se faire ?

Par exemple, si choix TrainScanner dans Scope alors DetailledScope affichera la liste : Wheel Monxx, Pantographxxxxxx, Brake Montixxx, Integrity Check

En te remerciant une nouvelle fois pour ton aide

 

[ozone083]

Soan

Je n'avais pas réalisé que tu avais fait les modifications
Cela fonctionne parfaitement, un grand merci.

Si tu arrivais à faire la modification demandée précédemment, cela serait le top du top !!

 

[soan]

Bonjour ozone,

tu as écrit : « pour Detailled Scope, il faut que je puisse choisir plusieurs valeurs et non pas une seule ... il faudrait faire un ListBox. Est-ce exact ? »

oui, c'est bien ça, et c'est fait dans le fichier joint ci-dessous. ; attention : sur les 2 formulaires, les infos de Detailled Scope sont « en clair » ; sur la feuille "Source", en colonne G, afin d'éviter de mettre une colonne pour chaque choix de la ListBox, et pour éviter aussi une autre solution avec une chaîne de caractères trop longue (pour y mettre tous les choix sélectionnés par l'utilisateur), j'ai choisi de mettre une liste de chiffres séparés par un signe « ; » ; de plus, c'est à partir de 1 alors que pour la ListBox, c'est à partir de 0 ; exemple 1 : en Source!G5, il y a "1;6" ; sur la feuille "LISTE", c'est les items 1 et 6 (O2 et O7) ; pour la ListBox, c'est les items 0 et 5 ; exemple 2 : en Source!G2, il y a "3;5" ; sur la feuille "LISTE", c'est les items 3 et 5 (O4 et O6) ; pour la ListBox, c'est les items 2 et 4 ; bien sûr, ça fait ce qu'il faut pour le bouton "New Input" de frmSaisie ; et sur frmRecherche, ça fait ce qu'il faut pour l'affichage de LboDetailledScope quand tu choisis un item de la liste CboTender ; enfin, ça fait aussi ce qu'il faut pour le bouton "MODIFY" ; bien sûr, tout ceci a entraîné beaucoup de changements des 2 UserForms (apparence du formulaire et code VBA associé).​

module de frmRecherche (57 lignes) :

Option Explicit

Private Sub CboTender_Change()
  Dim cel As Range: If CboTender = "" Then Exit Sub
  With Worksheets("SOURCE")
    .Select: [A1].Select: Application.ScreenUpdating = 0
    Set cel = .Columns(1).Find(CboTender, , -4163, 1, 1)
  End With
  If cel Is Nothing Then Exit Sub
  Dim T, chn$, i As Byte
  TextBOID = "": TextSegment = "": TextRegion = "": TextCountry = ""
  TextScope = "": TextContractDuration = "": TextNTP = ""
  TextCAPEX = "": TextOPEX = ""
  For i = 0 To 5: LboDetailledScope.Selected(i) = 0: Next i
  With Cells(cel.Row, 1)
    TextBOID = .Offset(, 1): TextRegion = .Offset(, 2): TextCountry = .Offset(, 3)
    TextSegment = .Offset(, 4): TextScope = .Offset(, 5): chn = .Offset(, 6)
    If chn <> "" Then
      T = Split(chn, ";")
      For i = 0 To UBound(T): LboDetailledScope.Selected(T(i) - 1) = True: Next i
    End If
    TextContractDuration = .Offset(, 7): TextNTP = .Offset(, 8)
    TextCAPEX = Format(.Offset(, 9), "Currency")
    TextOPEX = Format(.Offset(, 10), "Currency")
  End With
End Sub

Private Sub BtnModify_Click()
  Dim cel As Range: If CboTender = "" Then Exit Sub
  With Worksheets("SOURCE")
    .Select: [A1].Select: Application.ScreenUpdating = 0
    Set cel = .Columns(1).Find(CboTender, , -4163, 1, 1)
  End With
  If cel Is Nothing Then Exit Sub
  Dim chn$, i As Byte
  With Cells(cel.Row, 1)
    .Offset(, 1) = TextBOID: .Offset(, 2) = TextRegion: .Offset(, 3) = TextCountry
    .Offset(, 4) = TextSegment: .Offset(, 5) = TextScope
    .Offset(, 7) = TextContractDuration: .Offset(, 8) = TextNTP
    .Offset(, 9) = TextCAPEX: .Offset(, 10) = TextOPEX
    For i = 0 To 5
      If LboDetailledScope.Selected(i) Then chn = chn & i + 1 & ";"
    Next i
    i = Len(chn): If i > 0 Then .Offset(, 6) = Left$(chn, i - 1)
  End With
  Application.ScreenUpdating = -1
End Sub

Private Sub BtnClose_Click()
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  LblMessage = "Please select the Tender Name in the database"
  LboDetailledScope.List = [Liste!O2:O7].Value
End Sub

module de frmSaisie (42 lignes) :

Option Explicit

Private Sub TxtTenderName_Change()
  'bouton saisie activé si données Nom TEnder
  BtnAdd.Enabled = (TxtTenderName <> "")
End Sub

Private Sub BtnAdd_Click() 'ajout de nouvelles infos dans la database
  Worksheets("SOURCE").Select: [A1].Select: Application.ScreenUpdating = 0
  Dim lig&, chn$, i As Byte: lig = Cells(Rows.Count, 1).End(3).Row + 1
  With Cells(lig, 1)
    .Value = TxtTenderName: .Offset(, 1) = TxtBOID: .Offset(, 2) = CboRegion
    .Offset(, 3) = TxtCountry: .Offset(, 4) = CboSegment
    .Offset(, 5) = CboScope: .Offset(, 7) = TxtContractDuration
    .Offset(, 8) = TxtNTP: .Offset(, 9) = TxtCAPEX: .Offset(, 10) = TxtOPEX
    For i = 0 To 5
      If LboDetailledScope.Selected(i) Then chn = chn & i + 1 & ";"
    Next i
    i = Len(chn): If i > 0 Then .Offset(, 6) = Left$(chn, i - 1)
  End With
  Application.ScreenUpdating = -1
End Sub

Private Sub BtnDatabase_Click() 'va sur la base de données
  Worksheets("SOURCE").Select: [A1].Select
End Sub

Private Sub BtnErase_Click() 'efface tous les champs du formulaire
  TxtTenderName = "": TxtBOID = "": CboSegment = "": CboRegion = "": TxtCountry = ""
  CboScope = "": LboDetailledScope = "": TxtContractDuration = "": TxtNTP = ""
  TxtCAPEX = "": TxtOPEX = ""
End Sub

Private Sub BtnExit_Click() 'ferme le formulaire
  Unload Me
End Sub

Private Sub UserForm_Initialize()
  LblMessage = "Please fill-up all the info, please"
  LboDetailledScope.List = [Liste!O2:O7].Value
End Sub

le module M1_OpenForm est resté le même.

---

Mais du coup comment adapter le code pour que suivant la valeur de Scope, il affiche la liste Detailled Scope et qu'un choix multiple puisse se faire ?

Par exemple, si choix TrainScanner dans Scope alors DetailledScope affichera la liste : Wheel Monxx, Pantographxxxxxx, Brake Montixxx, Integrity Check

là, désolé, je passe ! car j'suis pas très doué pour les listes qui dépendent d'autres listes ; tu peux faire une recherche sur « listes en cascade » ; ou peut-être qu'un autre contributeur pourra t'aider là-dessus ? mais dans ce cas, je crois que ce serait mieux que tu crées un autre sujet, et que tu mettes dans ton énoncé une liste complète de toutes les dépendances possibles. (et surtout pas quelques exemples seulement !)​

bonne chance !

soan

 

[ozone083]

C'est super ce que tu as fait Soan, un grand merci.
POur retrouver les correspondances chiffres -> info Liste, j'applique un recherchev et cela fonctionne bien

Bref du tonnerre !!!

Merci beaucoup.

 

[ozone083]

Soan,

Une question : lorsque je clique sur SEARCH alors que précédemment j'avais cliqué sur NEWTENDERINPUT, Excel plante.......
Mais peut être est ce à un soucis avec Excel sur mon PC.

Est ce le cas pour toi ou tout se passe bien ?

Merci

 

[soan]

Bonsoir ozone,

j'ai tardé à te répondre car je n'étais pas disponible :

je clique sur "NEW TENDER INPUT" ➯ affichage du UserForm "frmSaisie" ; puis je ferme ce UserForm : clic / bouton "Exit" ou sur la croix du coin haut droit ; juste après, je clique sur la mire de SEARCH ou sur le texte "SEARCH" ➯ affichage du UserForm "frmRecherche", sans plantage ! juste après, je ferme ce 2ème UserForm : clic / bouton "CLOSE" ou sur la croix du coin haut droit ; c'est toujours ok : pas de plantage !

donc le problème se produit seulement sur ton PC ; c'est peut-être dû à ceci : au départ, la mire et le texte "SEARCH" étaient 2 images différentes, et pour chacune, tu as affecté la macro OpenFormulaireSearch ; moi, j'ai groupé les 2 images pour n'en faire qu'une seule ; bizarrement, malgré ce regroupement, j'ai ces 3 choses différentes :

1) macro affectée au rectangle de la mire et du texte "SEARCH" réunis : Groupe8_Clic

2) macro affectée à la mire : OpenSearchForm

3) macro affectée au texte "SEARCH" : OpenSearchForm

je n'ai pas d'explication sur le fait que malgré le groupement, j'arrive à sélectionner avec le clic droit la mire ou le texte "SEARCH" ; à tout hasard, sélectionne avec un clic droit le rectangle de la mire et du texte "SEARCH" réunis, puis dans le menu contextuel, clique sur l'item « Affecter une macro... » ; tu devrais voir ceci :

sélectionne en dessous OpenSearchForm, et clique en bas sur le bouton OK ; peut-être que ça va réparer ton problème ? c'est sans garantie, et j'ai rien d'autre à proposer. bonne chance !
​

soan