formulaire usf

L

lili

Guest
bonsoir,
j ai trouvé sur ce forum la semaine derniere un super fichier de thierry "thierry's macro démo" une base de données gérée avec un userform
Il avait pourtant bien prévenu dans son fichier que les débutants devaient ne pas y toucher mais j'ai voulu essayé quand meme et je me retrouve a m arracher les cheveux.!
J'ai une peremiere feuille avec mon bouton go to userform une seconde avec ma database et une troisieme avec des listes pour mes listbox

A l'initialisation du userform je n'arrive plus a avoir les informations de l'ensemble de ma base dans ma listbox1 'commune-numero-adresse de l'ensemble de la feuille excel)
j ai verifié tous les codes et je ne trouve pas ou ca plante
losque je clic sur mise a jour l'ensemble de mes données devraient s'inscrire sur le coté gauche et etre modiffiable... cela marche correctement pour les textbox mais pas pour les listbox??

Je remercie thierry pour ce fichier qui m a permis de me familiariser avec les macro et les userfom

Option Explicit

Dim NomLBindex As Integer
Dim LRecherche As Integer

'Thierry's Macro Démo pour www.excel-Downloads.com, January 2003
'j'ai volontairement laissé les nom de chaque control d'origine pour que vous puissiez suivre.
'Bonne Visite @+Thierry Version001 15/01/2003

'intialisation du userform
Private Sub UserForm_Initialize()
Dim rng As Range
Dim ligne As Range
Dim cell As Range
Dim H As Integer

With TextBox1
.Value = ""
.Enabled = False
End With
With TextBox15
.Value = ""
.Enabled = False
End With
With TextBox14
.Value = ""
.Enabled = False
End With
With TextBox9
.Value = ""
.Enabled = False
End With
With TextBox5
.Value = ""
.Enabled = False
End With
With TextBox3
.Value = ""
.Enabled = False
End With
With TextBox2
.Value = ""
.Enabled = False
End With


ListBox3.Enabled = False
ListBox4.Enabled = False
ListBox5.Enabled = False
ListBox6.Enabled = False

'afficher la listbox3 des communes
With ThisWorkbook.Worksheets("liste")
.Activate
Set rng = .Range("A2:A20")
ListBox3.Clear
For Each cell In rng
If cell.Text <> "" Then
ListBox3.AddItem cell.Text
Else
Exit For
End If
Next cell
End With

'afficher la liste des types
With ThisWorkbook.Worksheets("liste")
.Activate
Set rng = .Range("C2:C19")
ListBox4.Clear
For Each cell In rng
If cell.Text <> "" Then
ListBox4.AddItem cell.Text
Else
Exit For
End If
Next cell
End With

'afficher la liste des verificateurs
With ThisWorkbook.Worksheets("liste")
.Activate
Set rng = .Range("E2:E20")
ListBox5.Clear
For Each cell In rng
If cell.Text <> "" Then
ListBox5.AddItem cell.Text
Else
Exit For
End If
Next cell
End With

'afficher la liste disponibilités
With ThisWorkbook.Worksheets("liste")
.Activate
Set rng = .Range("D2:D3")
ListBox6.Clear
For Each cell In rng
If cell.Text <> "" Then
ListBox6.AddItem cell.Text
Else
Exit For
End If
Next cell
End With

SortNom
'affiche dans liste box1 avec commune n°hydrant et rue
With ThisWorkbook.Worksheets("database")
.Activate
H = Sheets("database").Range("A65536").End(xlUp).Row
Set rng = .Range("A2").CurrentRegion
Set rng = .Range("A2:R" & H)
ListBox1.Clear
For Each ligne In rng.Rows
If Cells(ligne.Row, 4) <> "" Then
ListBox1.AddItem Cells(ligne.Row, 1) & " - " & Cells(ligne.Row, 3) & " / " & Cells(ligne.Row, 6) & " " & Cells(ligne.Row, 7)
Else
Exit For
End If
Next ligne
End With

CommandButton11.Visible = False
Frame1.Visible = False

UserForm1.Caption = "hydrants: Mode standard"
End Sub

Private Sub ListBox1_Click() ' <<LE PREMIER CLICK VRAISSEMBLABLE

Dim rng As Range
Dim ligne As Range
Dim cell As Range

'affiche les textes
NomLBindex = ListBox1.ListIndex + 2
TextBox15 = Sheets("Database").Range("B" & NomLBindex)
TextBox1 = Sheets("Database").Range("C" & NomLBindex)
TextBox14 = Sheets("Database").Range("D" & NomLBindex)
TextBox9 = Sheets("Database").Range("I" & NomLBindex)
TextBox5 = Sheets("Database").Range("F" & NomLBindex)
TextBox3 = Sheets("Database").Range("G" & NomLBindex)
TextBox2 = Sheets("Database").Range("H" & NomLBindex)
TextBox7 = Sheets("Database").Range("J" & NomLBindex)
TextBox6 = Sheets("Database").Range("K" & NomLBindex)
TextBox8 = Sheets("Database").Range("L" & NomLBindex)
TextBox10 = Sheets("Database").Range("M" & NomLBindex)
TextBox11 = Sheets("Database").Range("N" & NomLBindex)
TextBox12 = Sheets("Database").Range("R" & NomLBindex)
TextBox13 = Sheets("Database").Range("Q" & NomLBindex)

'affiche de l'hydrant selectionné dans les listbox
ListBox3 = Sheets("Database").Cells(NomLBindex, 1)
ListBox4 = Sheets("Database").Cells(NomLBindex, 5)
ListBox5 = Sheets("Database").Cells(NomLBindex, 16)

CommandButton7.Visible = True
CommandButton25.Visible = False

End Sub

'<<<<<<<CHANGEMENT>>>>>
'bouton nouveau : creation nouvel hydrant
Private Sub CommandButton1_Click()
With TextBox1
.Value = ""
.Enabled = True
.BackColor = RGB(255, 255, 0)
End With
With TextBox15
.Value = ""
.Enabled = True
End With
With TextBox14
.Value = ""
.Enabled = True
End With
With TextBox3
.Value = ""
.Enabled = True
.BackColor = RGB(255, 255, 0)
End With
With TextBox2
.Value = ""
.Enabled = True
.BackColor = RGB(255, 255, 0)
End With

ListBox3.Enabled = True
ListBox3.BackColor = RGB(255, 255, 0)
ListBox4.Enabled = True
ListBox4.BackColor = RGB(255, 255, 0)
ListBox5.Enabled = True
ListBox5.BackColor = RGB(255, 255, 0)
ListBox6.Enabled = True
ListBox6.BackColor = RGB(255, 255, 0)

UserForm1.Caption = "hydrants:Mode Création"
CommandButton25.Visible = True
CommandButton8.Visible = True
CommandButton6.Visible = False
CommandButton11.Visible = False
Frame1.Visible = False
Frame2.Visible = False
UserForm1.BackColor = RGB(255, 255, 150)
UserForm1.Height = 470
UserForm1.Width = 300
With Frame3
.Left = 10
End With

End Sub

'mode validation de la creation d'hydrant
Private Sub CommandButton25_Click()
'controle des données
Dim Msg1 As String
Dim Msg2 As String
Dim L2 As Integer
If TextBox1 = "" Then
MsgBox "Vous devez indiquer un numero de poteau ? ", vbCritical, "hydrants= Mode Validation Error"
Exit Sub
End If
If IsNull(ListBox3) Then
MsgBox "Vous devez indiquer une commune", vbCritical, "hydrants = Mode Validation Error"
Exit Sub
End If
If IsNull(ListBox4) Then
MsgBox "Vous devez indiquer une commune", vbCritical, "hydrants = Mode Validation Error"
Exit Sub
End If
If TextBox7 = "" And TextBox6 = "" Then
MsgBox "Votre hydrant doit au minimu avoir un débit ou une pression", vbCritical, "hydrants = Mode Validation Error"
Exit Sub
End If
If IsNull(ListBox5) Then
MsgBox "Vous devez indiquer le centre verificateur", vbCritical, "hydrants = Mode Validation Error"
Exit Sub
End If

Msg1 = MsgBox("Voulez-vous ajouter ce nouvel hydrant ? " _
& vbCrLf & vbTab & "comune : " & vbTab & ListBox3 _
& vbCrLf & vbTab & "N°poteau : " & vbTab & TextBox1 _
& vbCrLf & vbTab & "type : " & vbTab & ListBox4 _
& vbCrLf & vbTab & "débit : " & vbTab & TextBox7, vbYesNo, "hydrant => Mode Validation")

'ajout de l'hydrant crée
If Msg1 = vbYes Then
ListBox1 = ""
L2 = Sheets("Database").Range("A65536").End(xlUp).Row + 1
With Sheets("database")
.Range("A" & L2).Value = ListBox3.Value
.Range("B" & L2).Value = TextBox15.Value
.Range("C" & L2).Value = TextBox1.Value
.Range("D" & L2).Value = TextBox14.Value
.Range("E" & L2).Value = ListBox4.Value
.Range("F" & L2).Value = TextBox5.Value
.Range("G" & L2).Value = TextBox3.Value
.Range("H" & L2).Value = TextBox2.Value
.Range("I" & L2).Value = TextBox9.Value
.Range("J" & L2).Value = TextBox7.Value
.Range("K" & L2).Value = TextBox6.Value
.Range("L" & L2).Value = TextBox8.Value
.Range("M" & L2).Value = TextBox10.Value
.Range("N" & L2).Value = TextBox11.Value
.Range("O" & L2).Value = ListBox6.Value
.Range("P" & L2).Value = ListBox5.Value
.Range("Q" & L2).Value = TextBox13.Value
.Range("R" & L2).Value = TextBox12.Value
End With
Else: TextBox1 = ""
End If
Msg2 = MsgBox("Voulez-vous continuer pour d'autres nouvelles entrées ?", _
vbYesNo, "hydrants=> Mode Nouveau Continuer ?")
If Msg2 = vbYes Then

'===CHANTIER !
' L2 = Sheets("Database").Range("A65536").End(xlUp).Row

TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox15 = ""
TextBox14 = ""
TextBox3 = ""
TextBox5 = ""
TextBox7 = ""
TextBox6 = ""
TextBox8 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox1.SetFocus
Else
Unload Me
UserForm1.Show
End If
End Sub

'<<<<<<<<CHANGEMENT>>>>>>>>>

Private Sub CommandButton7_Click() 'LANCEMENT MODE MAJ
With TextBox1
.Value = ""
.Enabled = True
.BackColor = RGB(255, 222, 220)
End With
With TextBox15
.Value = ""
.Enabled = True
End With
With TextBox14
.Value = ""
.Enabled = True
End With
With TextBox9
.Value = ""
.Enabled = True
.BackColor = RGB(255, 222, 220)
End With
With TextBox5
.Value = ""
.Enabled = True
.BackColor = RGB(255, 222, 220)
End With
With TextBox3
.Value = ""
.Enabled = True
.BackColor = RGB(255, 222, 220)
End With
With TextBox2
.Value = ""
.Enabled = True
.BackColor = RGB(255, 222, 220)
End With


ListBox3.Enabled = True
ListBox3.BackColor = RGB(255, 220, 220)
ListBox4.Enabled = True
ListBox4.BackColor = RGB(255, 220, 220)
ListBox5.Enabled = True
ListBox5.BackColor = RGB(255, 220, 220)
ListBox6.Enabled = True
ListBox6.BackColor = RGB(255, 220, 220)


Dim rng As Range
Dim ligne As Range
Dim cell As Range

'affiche les textes

NomLBindex = ListBox1.ListIndex + 2
TextBox15 = Sheets("Database").Range("B" & NomLBindex)
TextBox1 = Sheets("Database").Range("C" & NomLBindex)
TextBox14 = Sheets("Database").Range("D" & NomLBindex)
TextBox9 = Sheets("Database").Range("I" & NomLBindex)
TextBox5 = Sheets("Database").Range("F" & NomLBindex)
TextBox3 = Sheets("Database").Range("G" & NomLBindex)
TextBox2 = Sheets("Database").Range("H" & NomLBindex)
TextBox7 = Sheets("Database").Range("J" & NomLBindex)
TextBox6 = Sheets("Database").Range("K" & NomLBindex)
TextBox8 = Sheets("Database").Range("L" & NomLBindex)
TextBox10 = Sheets("Database").Range("M" & NomLBindex)
TextBox11 = Sheets("Database").Range("N" & NomLBindex)
TextBox12 = Sheets("Database").Range("R" & NomLBindex)
TextBox13 = Sheets("Database").Range("Q" & NomLBindex)

'ListBox3 = Sheets("Database").Range("A" & NomLBindex)
'affiche de l'hydrant selectionné dans les listbox
ListBox3 = Sheets("Database").Cells(NomLBindex, 1)
ListBox4 = Sheets("Database").Cells(NomLBindex, 5)
ListBox5 = Sheets("Database").Cells(NomLBindex, 16)



UserForm1.Caption = "hydrants => MODE MISE A JOUR"
CommandButton1.Visible = False
CommandButton25.Visible = False
CommandButton6.Visible = False
CommandButton8.Visible = True
CommandButton11.Visible = True
Frame1.Visible = False
UserForm1.BackColor = RGB(255, 220, 222)
Label9.BackColor = RGB(255, 220, 245)
Label10.BackColor = RGB(255, 220, 245)
Label12.BackColor = RGB(255, 220, 245)
Label13.BackColor = RGB(255, 220, 245)
TextBox1.SetFocus
End Sub


Private Sub CommandButton8_Click() 'MODE SUPRESSION MAJ
Dim Msg As String
Msg = MsgBox("Etes-vous sur de vouloir supprimer " _
& vbCrLf & vbCrLf & vbTab & TextBox1 & " ?", vbYesNo, "hydrants => Mode Supression Contact ???")
If Msg = vbYes Then
ListBox1.Value = ""
With Sheets("database")
.Range("A" & NomLBindex).Value = ""
.Range("B" & NomLBindex).Value = ""
.Range("C" & NomLBindex).Value = ""
.Range("D" & NomLBindex).Value = ""
.Range("E" & NomLBindex).Value = ""
.Range("F" & NomLBindex).Value = ""
.Range("G" & NomLBindex).Value = ""
.Range("H" & NomLBindex).Value = ""
.Range("I" & NomLBindex).Value = ""
.Range("J" & NomLBindex).Value = ""
.Range("K" & NomLBindex).Value = ""
.Range("L" & NomLBindex).Value = ""
.Range("M" & NomLBindex).Value = ""
.Range("N" & NomLBindex).Value = ""
.Range("O" & NomLBindex).Value = ""
.Range("P" & NomLBindex).Value = ""
.Range("Q" & NomLBindex).Value = ""
.Range("R" & NomLBindex).Value = ""
End With
Unload Me
UserForm1.Show
End If
End Sub

Private Sub SortNom()
Dim L As Integer
Dim Plage As Range
L = Sheets("Database").Range("A65536").End(xlUp).Row
Set Plage = Sheets("Database").Range("A1:R" & L)
Plage.Sort key1:=Worksheets("Database").Columns("A"), Order1:=xlAscending, key2:=Worksheets("Database").Columns("C"), order2:=xlAscending, header:=xlYes
End Sub


Private Sub CommandButton11_Click()
ListBox1.Value = ""
If TextBox1 = "" Then
MsgBox "Vous ne pouvez pas supprimmer le nom du Contact ! ", _
vbCritical, "Thierry's Démo = Mode Mise à Jour Validation Error"
Exit Sub
End If
If TextBox2 = "" And TextBox3 = "" Then
MsgBox "Votre Contact doit au minimu avoir un Email ou un Téléphone", _
vbCritical, "Thierry's Démo = Mode Nouveau Validation Error"
Exit Sub
End If
With Sheets("database")
.Range("A" & NomLBindex).Value = ListBox3.Value
.Range("B" & NomLBindex).Value = TextBox15.Value
.Range("C" & NomLBindex).Value = TextBox1.Value
.Range("D" & NomLBindex).Value = TextBox14.Value
.Range("E" & NomLBindex).Value = ListBox4.Value
.Range("F" & NomLBindex).Value = TextBox5.Value
.Range("G" & NomLBindex).Value = TextBox3.Value
.Range("H" & NomLBindex).Value = TextBox2.Value
.Range("I" & NomLBindex).Value = TextBox9.Value
.Range("J" & NomLBindex).Value = TextBox7.Value
.Range("K" & NomLBindex).Value = TextBox6.Value
.Range("L" & NomLBindex).Value = TextBox8.Value
.Range("M" & NomLBindex).Value = TextBox10.Value
.Range("N" & NomLBindex).Value = TextBox11.Value
.Range("O" & NomLBindex).Value = ListBox6.Value
.Range("P" & NomLBindex).Value = ListBox5.Value
.Range("Q" & NomLBindex).Value = TextBox13.Value
.Range("R" & NomLBindex).Value = TextBox12.Value
End With
MsgBox TextBox1 & " à bien été mis à jour " _
& vbCrLf & vbCrLf & vbTab & "commune= " & vbTab & ListBox3 _
& vbCrLf & vbCrLf & vbTab & "numero = " & vbTab & TextBox1 _
& vbCrLf & vbCrLf & vbTab & "debit = " & vbTab & TextBox7, _
vbInformation, "hydrants => Mode Mise à Jour Accomplie"
Unload Me
UserForm1.Show
End Sub

D'avance merci a tous
oréli
 
Trier par date Trier par votes
Q

Qq1 de bien....

Guest
Bonsoir...



Je profite de ton message pour passer un mini coup de gueule (désolé mais ça tombe sur toi....)

1) SVP quand vous envoyez de macro eviter de le faire comme LILI... c'est long à "lire" et encore Plus à comprendre.... (on ne sais pas toujour à quoi correspond par exemple Textbox2....si c'est une petite macro on peu prendre le tps de créer vite fais mais Là........ ) donc essayez de: soit mieux ciblé vos macro; ou vos pblm (je sais c'est pas toujours simple....) que vous copiez/collez.... OU "mieux" zipper" votre PETIT classeur et mettez le en pièce jointe....(ou dans ce cas mettez au moins un liens que l'on puisse récup. directement le classeur que l'on puisse essayé de vous aidez....)

2) je ne dis pas ça pour lili mais avant de envoyez un message de SECOURS.... faites au moins une recherche sur le forum (en 2 jours j'ai vu au moins 3 messages sur "Clique droit => menu contextuel d'Excel"...)

3) Je m'excuse de te le dire comme ça lili mais perso en voyant la demande que tu fais et rien que la longueur de ton mail ...bin j'ai pas ; mais alors pas du tout envie de m'y collé.... et c'est pas que je veux pas t'aider... mais c'est un poil trop long à mon gout...


C'est en faisant des testes qu'on apprends...

voilà... encore désolé pour lili... je sais que je suis peut être un peu "méchant" mais si on demande de l'aide je pense qu'il faut aussi ce mettre à la place de celui/celle qui aide.... (et j'ai régulièrement des pblm.... donc.....)


Bye
 
Vote positif 0 Vote négatif
L

lili

Guest
bonjour
c'est la premiere fois que j'utilise ce forum et j'avoue en revoyant (apres une bonne nuit de sommeil) mon mail que ce n'etait pas terrible
je m 'excuse donc pour la longueur de ce message et je suis le conseil de qql de bien en mettant un lien vers mon classeur excel.

http://fr.f1.pg.briefcase.yahoo.com/aureliefonteyne


en regardant de nouveau ce matin ma macro mon probleme survient quand je crée un nouvel objet. la list box1 ne le prend pas en compte.

merci
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
357
Francky79
F
D
  • Question
XL 2021 Filtre Multi Critères Listview VBA
2
Réponses
21
Affichages
1 K
Dranreb
Dranreb
M
  • Question
XL 2021 Vba Userform textbox.value
Réponses
3
Affichages
338
MNico1862
M
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
308
souhaib ad
S
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
477
AtTheOne
AtTheOne
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
889
Nicolas JACQUIN
Nicolas JACQUIN
Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
364
Franc58
F
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
1 K
Banbara
B
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
875
Dudy
D
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
259
NONO14
N

Membres actuellement en ligne

2 membres et 54 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 655
Messages
2 111 604
Membres
111 217
dernier inscrit
aladinkabeya2