XL 2010 reglage userform

fabrice31

XLDnaute Junior
bonjour a tous,

déjà, merci à ceux qui répondent: vous m'avez déjà bcp aidé!
mais la, je bloque depuis 1 semaine...(j'ai plus bcp de cheveux!)

voici mon 1er userform...:
combobox depuis liste de données (qui ne remonte pas)
3 textbox
2 boutons

plusieurs choses:
la combobox est vide (il faudrait la colonne C de "données")
le curseur ne bouge pas et les boutons inactifs
Pb au lancement depuis bouton 182

une fois que cela marche, j'aimerai intégrer les données dans chaque feuille annuelle, à la suite du modèle précisée ds le combobox.... mais j'essaierai.

voici mon code: attention, c'est du patchwork!! :)


Private Sub CommandButton1_Click()
Unload Me
End Sub


Private Sub UserForm_Initialize() 'parametrage USF
mon_userform.Height = 250
mon_userform.Width = 240
ComboBox_pompe.AddItem "AC-SPERHI Mystrale"
ComboBox_pompe.AddItem "AC-SPERHI Expert Autonome"
ComboBox_pompe.AddItem "AC-SPERHI Mystrale Autonome"
ComboBox_pompe.AddItem "C&S - SMART PUMP 1.6"
ComboBox_pompe.AddItem "C&S - SMART PUMP B"
ComboBox_pompe.AddItem "DELTANOVA GH18G3"

End Sub

Private Sub CommandButton2_Click() 'alerte erreur
If TextBox_serie.Value = "" Then
Label1.ForeColor = RGB(255, 0, 0)
ElseIf TextBox_MES.Value = "" Then
Label2.ForeColor = RGB(255, 0, 0)
ElseIf TextBox_etalonnage.Value = "" Then
Label3.ForeColor = RGB(255, 0, 0)
ElseIf ComboBox_pompe.Value = "" Then
Label.ComboBox_pompe.ForeColor = RGB(255, 0, 0)
Else

Dim modele As String, no_ligne As Long, lastrow As Long

If ComboBox_pompe.Value <> "" Then
modele = ComboBox_pompe.Value

lastrow = Range("B" & Rows.Count).End(xlUp).Row 'recherche emplacement insertion données
For i = lastrow To 8
If Cells(i - 1, 2) = modele Then
Row(i).Insert shift:=xlDown
Next

no_ligne = i + 1

Range(no_ligne, 1) = textbox_kalilab.Value 'insertion données
Range(no_ligne, 3) = TextBox_serie.Value
Range(no_ligne, 4) = TextBox_MES.Value
Range(no_ligne, 5) = TextBox_etalonnage.Value

OptionButton2.Value = True 'reinitialisation
TextBox_serie.Value = ""
TextBox_MES.Value = ""
TextBox_etalonnage.Value = ""
ComboBox_pompe.Value = ""
End Sub


merci d'avance.

fabrice
 

Pièces jointes

  • Planificateur base.xlsm
    1.6 MB · Affichages: 21

vgendron

XLDnaute Barbatruc
Bonjour

dans les références du projet, il y a une réf manquante qui fait bugger le programme.. je l'ai enlevée.. ca ne bug plus..

ensuite.. à l'ouverture de ton fichier.. QUELLE feuille est censée être ouverte?

et pour que ton Userform soit actif. il faut le passer en Enable dans ses propriétés
 
Dernière édition:

fabrice31

XLDnaute Junior
bonjour vgendron et merci de repondre.

je ne vois pas ce que tu as enlevé...dsl

j'ai bien avancé (j'ai compris l'utilité des propriétés...)
l'ouverture par le bouton marche, ma liste est comme je la veux, j'ai mis le format date dans 2 textbox...

par contre, je bloque tjrs pour l'insertion dans mon fichier.

mon USF repondra au bouton 'ajouter materiel' sur la feuille 'recap', et devra insérer les données sur la dernière ligne du bloc 'modele de pompe choisit dans combobox', dans les feuilles de chaque année.

je pensais faire une cherche de "modele de pompe.value" dans la colonne B en remontant et insertion de ligne lorsque match

en lançant la procédure d'insertion, il bloque sur la variable 'modele'...

je remets mon fichier avancé.
 

Pièces jointes

  • Planificateur base.xlsm
    1.6 MB · Affichages: 16

vgendron

XLDnaute Barbatruc
Re
voir rev 2 en PJ
1) j'ai simplifié tous tes codes liées à l'activation des feuilles et à l'ouverture du classeur
si j'ai bien compris.. tu souhaites te positionner sur la date du jour avec un scroll -10
c'est donc la macro AllerSurDate qui le fait - et qui est appelée à chaque activation de feuille

2) dans la feuille Données, tu as une liste de pompes qui sert à alimenter ton combobox
j'ai donc créer un nom de liste "dynamique" (cf gestionnaire de nom)
et ce nom de liste est utilisé dans le code _initialize pour alimenter directment ton combo: plus la peine de faire des additems

3) dans le code associé au bouton "Ajouter" du formulaire:
tu sembles commencer par vérifier si toutes les infos sont saisies. et tu mets en rouge les libelles
--> je crois qu'il y a un décalage dans les libelles
--> tu fais des tests imbriqués.. tu risques d'oublier certaines boites..
j'ai modifié: tu vas voir ce que ca fait

4) pour l'ajout des lignes
avant d'ajouter. tu ne vérifies pas si la ligne existe déjà?
le code actuel semble insérer une ligne à chaque fois qu'il trouve le matériel..
 

Pièces jointes

  • Planificateur base Rev2.xlsm
    1.6 MB · Affichages: 18

fabrice31

XLDnaute Junior
Re
voir rev 2 en PJ
1) j'ai simplifié tous tes codes liées à l'activation des feuilles et à l'ouverture du classeur
si j'ai bien compris.. tu souhaites te positionner sur la date du jour avec un scroll -10
c'est donc la macro AllerSurDate qui le fait - et qui est appelée à chaque activation de feuille
Ca fait bcp plus propre, c'est clair
2) dans la feuille Données, tu as une liste de pompes qui sert à alimenter ton combobox
j'ai donc créer un nom de liste "dynamique" (cf gestionnaire de nom)
et ce nom de liste est utilisé dans le code _initialize pour alimenter directment ton combo: plus la peine de faire des additems
OK, parfait
3) dans le code associé au bouton "Ajouter" du formulaire:
tu sembles commencer par vérifier si toutes les infos sont saisies. et tu mets en rouge les libelles
--> je crois qu'il y a un décalage dans les libelles Vu et corriger dans le nouveau fichier, merci
--> tu fais des tests imbriqués.. tu risques d'oublier certaines boites..
j'ai modifié: tu vas voir ce que ca fait c'est classe, mais pas vraiment nécessaire avec 5 textbox. je préfère verrouiller les formats (date pour MES et étalonnage; N° série en majuscule; N°kalilab = 4 ou 5
caractères, sans espace ni carac spéciaux)


4) pour l'ajout des lignes
avant d'ajouter. tu ne vérifies pas si la ligne existe déjà? peu de risque mais pas bête.... verif par SI (N° série ou Kalilab) existe alors erreur
le code actuel semble insérer une ligne à chaque fois qu'il trouve le matériel..il faut insérer la ligne en bas du bloque ' pompe' concerné

je crois que je vais garder ton 06 à toi ;-)
grand merci en tout cas
 

vgendron

XLDnaute Barbatruc
un essai avec ce code que j'ai commenté au maximum
VB:
Private Sub UserForm_Initialize()
mon_userform.Height = 250
mon_userform.Width = 240
For Each ele In Range("Liste_Pompes") 'la range "Liste_Pompes" est définie dynamiquement dans la feuille Données
    ComboBox_pompe.AddItem ele
Next ele
End Sub

Private Sub CommandButton1_Click() 'Bouton Fermer
Unload Me
End Sub


Private Sub CommandButton2_Click() 'bouton Ajouter
'on vérifie d'abord que toutes les infos sont saisies
If ComboBox_pompe.Value = "" Then
    Label1.ForeColor = RGB(255, 0, 0)
    ManqueInfo = "Modèle de pompe"
End If
If TextBox_serie.Value = "" Then
    Label2.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "N° Série"
End If
If TextBox_MES.Value = "" Then
    Label3.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Date de MES"
End If
If TextBox_etalonnage.Value = "" Then
    Label4.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Dernier étalonnage"
End If
If TextBox_kalilab.Value = "" Then
    Label5.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Kalilab"
End If

If ManqueInfo <> "" Then 's'il manque quelque chose.. on l'indique et on quitte la macro
    'MsgBox "Manque les infos suivantes:" & Chr(10) & ManqueInfo
    Exit Sub
End If

Dim modele As String, no_ligne As Long, lastrow As Long
'ici. toutes les infos ont été saisies

'il faut trouver la dernière ligne du bloc de la pompe sélectionnée ??
With ActiveSheet 'Dans quelle feuille faut il vraiment travailler? quelle année? en fonction de quoi?
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    i = lastrow
    While .Range("B" & i) <> ComboBox_pompe.Value 'en partant du bas. on remonte jusqu'à trouver le Matériel
        i = i - 1
    Wend
   
    .Rows(i + 1).Insert shift:=xlDown 'on insère une ligne en dessous
    no_ligne = i + 1

    .Range("A" & no_ligne) = TextBox_kalilab.Value 'on rentre les valeurs
    .Range("B" & no_ligne) = ComboBox_pompe.Value
    .Range("C" & no_ligne) = TextBox_serie.Value
    .Range("D" & no_ligne) = CDate(TextBox_MES.Value)
    .Range("E" & no_ligne) = CDate(TextBox_etalonnage.Value)

    'et on vide le formulaire
    'OptionButton2.Value = True
    ComboBox_pompe.Value = ""
    TextBox_serie.Value = ""
    TextBox_MES.Value = ""
    TextBox_etalonnage.Value = ""
    TextBox_kalilab.Value = ""
   
End With
End Sub
 

vgendron

XLDnaute Barbatruc
et plutot ce code pour prendre en compte les formules qu'il y a en dessous de chaque bloc afin qu'elles soient mises à jour toutes seules
VB:
Private Sub UserForm_Initialize()
mon_userform.Height = 250
mon_userform.Width = 240
For Each ele In Range("Liste_Pompes") 'la range "Liste_Pompes" est définie dynamiquement dans la feuille Données
    ComboBox_pompe.AddItem ele
Next ele
End Sub

Private Sub CommandButton1_Click() 'Bouton Fermer
Unload Me
End Sub


Private Sub CommandButton2_Click() 'bouton Ajouter
'on vérifie d'abord que toutes les infos sont saisies
If ComboBox_pompe.Value = "" Then
    Label1.ForeColor = RGB(255, 0, 0)
    ManqueInfo = "Modèle de pompe"
End If
If TextBox_serie.Value = "" Then
    Label2.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "N° Série"
End If
If TextBox_MES.Value = "" Then
    Label3.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Date de MES"
End If
If TextBox_etalonnage.Value = "" Then
    Label4.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Dernier étalonnage"
End If
If TextBox_kalilab.Value = "" Then
    Label5.ForeColor = RGB(255, 0, 0)
    ManqueInfo = ManqueInfo & " - " & "Kalilab"
End If

If ManqueInfo <> "" Then 's'il manque quelque chose.. on l'indique et on quitte la macro
    'MsgBox "Manque les infos suivantes:" & Chr(10) & ManqueInfo
    Exit Sub
End If

Dim modele As String, no_ligne As Long, lastrow As Long
'ici. toutes les infos ont été saisies

'il faut trouver la dernière ligne du bloc de la pompe sélectionnée ??
With ActiveSheet
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    i = lastrow
    While .Range("B" & i) <> ComboBox_pompe.Value 'en partant du bas. on remonte jusqu'à trouver le Matériel
        i = i - 1
    Wend

    'AFIN de mettre à jour automatiquement les formules qui se trouvent en dessous du bloc (colonne B - F ...)
    .Rows(i).Copy 'on copie la dernière ligne
    .Rows(i).Insert shift:=xlDown 'on l'insère au dessus
    Application.CutCopyMode = False
   
    Rows(i + 1).ClearContents 'on efface la dernière ligne
   
    no_ligne = i + 1
   
    .Range("A" & no_ligne) = TextBox_kalilab.Value 'on rentre les valeurs
    .Range("B" & no_ligne) = ComboBox_pompe.Value
    .Range("C" & no_ligne) = TextBox_serie.Value
    .Range("D" & no_ligne) = CDate(TextBox_MES.Value)
    .Range("E" & no_ligne) = CDate(TextBox_etalonnage.Value)

    'et on vide le formulaire
    'OptionButton2.Value = True
    ComboBox_pompe.Value = ""
    TextBox_serie.Value = ""
    TextBox_MES.Value = ""
    TextBox_etalonnage.Value = ""
    TextBox_kalilab.Value = ""
   
End With
End Sub
 

vgendron

XLDnaute Barbatruc
et tu peux ajouter ces codes pour forcer la saisie de dates dans les 2 textbox
VB:
Private Sub TextBox_MES_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
TextBox_MES.MaxLength = 10   'nb caractères maxi autorisé dans le textbox
valeur = Len(TextBox_MES)
If valeur = 2 Or valeur = 5 Then TextBox_MES = TextBox_MES & "/"   'afficher "/" aprés la saisie des 2 premiers chiffres
'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
    If ((Split(TextBox_MES, "/")(0) > 31) Or (Split(TextBox_MES, "/")(1) > 12) Or (Split(TextBox_MES, "/")(2) < 1900)) Then
        TextBox_MES = ""
    End If
End If
End Sub

Private Sub TextBox_MES_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
     If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox_etalonnage_Change() 'pour controler la saisie d'une date au format dd/mm/yyyy
Dim valeur As Byte
TextBox_etalonnage.MaxLength = 10   'nb caractères maxi autorisé dans le textbox
valeur = Len(TextBox_etalonnage)
If valeur = 2 Or valeur = 5 Then TextBox_etalonnage = TextBox_etalonnage & "/"   'afficher "/" aprés la saisie des 2 premiers chiffres
'ajouter test pour vérifier la validité de la date saisie !
If valeur = 10 Then
    If ((Split(TextBox_etalonnage, "/")(0) > 31) Or (Split(TextBox_etalonnage, "/")(1) > 12) Or (Split(TextBox_etalonnage, "/")(2) < 1900)) Then
        TextBox_etalonnage = ""
    End If
End If
End Sub

Private Sub TextBox_etalonnage_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
' Interdire les lettres
     If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
 

fabrice31

XLDnaute Junior
ahhhrg!!
tu vas trop vite pour moi.....!

With ActiveSheet 'Dans quelle feuille faut il vraiment travailler? quelle année? en fonction de quoi?
la ligne est à saisir dans les feuilles 2017/2018/2019/2020... pour une mise à jour du matériel.
on peut même considérer la liste du matériel (colonne A à E)comme "liste de données" à mettre dans "données!" et la recopier dans les feuilles "années".
cela permet d'insérer les données de L'USF une seule fois, et lorsqu'on en supprime 1 matériel, on la supprime de toutes les feuilles... :-/

While .Range("B" & i) <> ComboBox_pompe.Value
pourquoi <> et pas =?? des qu'il trouve la même valeur, il s’arrête et insert une ligne...

j'ai rajouté ça pour le format date: (c'est ok)
Private Sub textbox_etalonnage_afterupdate()
TextBox_etalonnage.Value = Format(TextBox_etalonnage.Value, "dd/mm/yyyy")
End Sub

Private Sub TextBox_MES_afterupdate()
TextBox_MES.Value = Format(TextBox_MES.Value, "dd/mm/yyyy")
End Sub

pour la verif:
if .Range("A" & i) = textbox_kalilab.Value then
ManqueInfo = "N° KALILAB déjà existant"
end if
if .Range("C" & i)=TextBox_serie.Value then
manqueinfo = "N° série déjà existant"
end if
If ManqueInfo <> "" Then
MsgBox "Manque les infos suivantes:" & Chr(10) & ManqueInfo
Exit Sub
End If

mais je peux pas la tester, mon bouton ne marche plus!
désolé, mais je pose mon cerveau. j'en peux plus!!

PS: pour la formule, on insert la ligne en dessous de la dernière du bloc donc pas de soucis....?

encore merci et à demain j’espère!
 

Pièces jointes

  • Planificateur base off.xlsm
    1.6 MB · Affichages: 17

vgendron

XLDnaute Barbatruc
Salut
Je te propose de reprendre mon fichier
car dans le tiens,
il y a toujours ce pb de référence manquante (VBA - Outils Reference): MSExhchange 1.0 Type Library qui fait bugger le fichier dès l'ouverture: chez moi. il suffit que je la décoche pour que ca règle de problème

Ensuite, tu n'as pas repris les codes que je t'ai proposés
et ton bouton ne marche plus parce que la macro a changé de nom (c'était le meme nom pour la macro ET le module): j'avais un message d'erreur

Pour l'insertion de ligne dans toutes les feuilles, je regarde ca dès que j'ai un moment
mais il va "juste" falloir faire une boucle sur toutes les feuilles du classeur

Dans le fichier ci joint, j'ai fait une copie de la feuille 2017 (2) pour garder tes data d'origine
et dans la feuille 2017, j'ai supprimé toutes les lignes intermédiaires vides pour que ca ressemble aux autres feuilles 2018.2019....
 

Pièces jointes

  • Planificateur base Rev2.xlsm
    1.8 MB · Affichages: 15

fabrice31

XLDnaute Junior
Salut vgendron, et encore merci.

j'ai voulu garder la mienne pour essayer de tout comprendre plutôt que de faire un copier/coller tout bête. mais je n'ai plus que 1 cheveu sur le crane: je vais le garder!!

merci pour le menage et les codes.
a ton dernier code j'ai rajouté :
Code:
Dim fl As Worksheet             'pour rentrer les données dans chaque feuille
For Each fl In Worksheets
    If fl.Name <> "Récap" And fl.Name <> "données" Then
'il faut trouver la dernière ligne du bloc de la pompe sélectionnée
        With ActiveSheet
    lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
    i = lastrow

    While .Range("B" & i) <> ComboBox_pompe.Value 'en partant du bas. on remonte jusqu'à trouver le Matériel
        i = i - 1
    Wend

    'AFIN de mettre à jour automatiquement les formules qui se trouvent en dessous du bloc (colonne B - F ...)
    .Rows(i).Copy 'on copie la dernière ligne
    .Rows(i).Insert shift:=xlDown 'on l'insère au dessus
    Application.CutCopyMode = False
  
    Rows(i + 1).ClearContents 'on efface la dernière ligne
  
    no_ligne = i + 1
  
    .Range("A" & no_ligne) = TextBox_kalilab.Value 'on rentre les valeurs
    .Range("B" & no_ligne) = ComboBox_pompe.Value
    .Range("C" & no_ligne) = TextBox_serie.Value
    .Range("D" & no_ligne) = CDate(TextBox_MES.Value)
    .Range("E" & no_ligne) = CDate(TextBox_etalonnage.Value)
    End If
End With
qui ne marche pas et ca m'etonne...

et

Code:
If Find(TextBox_serie.Value, LookIn:="C:C") Then  ' pour contrôle si existant
TextBox_serie.Value.ForeColor = RGB(255, 0, 0)
ManqueInfo = "N° série déjà existant"
End If
If Find(TextBox_kalilab.Value, LookIn:="A:A") Then
TextBox_kalilab.Value.forecolr = RGB(255, 0, 0)
ManqueInfo = "N° KALILAB déjà existant"
End If
If ManqueInfo <> "" Then
    MsgBox ManqueInfo
    Exit Sub
End If
qui ne marche pas!! mais c'est moins etonnant

je me suis permis d'enlever les msgbox pour valeur manquante.

si tu as 2 min pour corriger ces 2 bouts...

for i=1 to 1000
i merci
next
 

vgendron

XLDnaute Barbatruc
Alors;. pour la boucle sur les feuilles. ca ne fonctionne pas à cause de CETTE ligne
With Activesheet....
il faut remplacer par
With fl

ensuite.. il faut penser à sortir de la boucle la partie "effacer le formulaire" pour la mettre à la fin de la boucle
cf PJ
qui ne marche pas!! mais c'est moins etonnant
la par contre. je n'ai pas saisi ce que tu cherches à faire..?
 

Pièces jointes

  • Planificateur base Rev3.xlsm
    1.8 MB · Affichages: 14

fabrice31

XLDnaute Junior
Alors;. pour la boucle sur les feuilles. ca ne fonctionne pas à cause de CETTE ligne
With Activesheet....
il faut remplacer par
With fl

ensuite.. il faut penser à sortir de la boucle la partie "effacer le formulaire" pour la mettre à la fin de la boucle
cf PJ
ça c'est ok, j'avais trouvé. :cool:
par contre, vider le formulaire ne marche pas.... :mad:

pour le IF find:
je contrôle si le numéro de série ou le numéro KALILAB existe déjà:
je cherche ds la colonne"A" si MES.value existe
je cherche ds la colonne "C" si kalilab existe
msgbox

2 petites choses où je plante aussi:
forcer la casse en MAJUSCULE
et quand on insert la ligne, on perd la formule en F
j'ai essayé ca sans succès:
Code:
        Application.CutCopyMode = False
    Cells(i + 1, 6).Select
    Selection.AutoFill Destination:=Cells(i + 2, 6), Type:=xlFillDefault
 

Discussions similaires

Réponses
5
Affichages
322