Aide pour listbox et bouton modifier
Re
ca non plus pas vu donc vu que c'est un cas unique, traité avec i=8 et j=33
Sub TransfertVersTableau()
Dim c, i, j, ws As Worksheet
Application.ScreenUpdating = False
Set ws = Sheets("Calendrier theme")
For i = 2 To 32 Step 6
For j = 5 To 68
If j <> 37 Then
If IsDate(Cells(j, i)) Or i = 8 And j = 33 Then
ws.Cells(j, i + 1) = ""
ws.Cells(j, i + 2) = ""
ws.Cells(j, i + 3) = ""
Set c = Sheets("BDD Previ").Columns(1).Find(Cells(j, i))
If Not c Is Nothing Then
ws.Cells(j, i + 1) = VBA.Left(c.Offset(0, 1), 4)
ws.Cells(j, i + 2) = VBA.Left(c.Offset(0, 2), 4)
ws.Cells(j, i + 3) = VBA.Left(c.Offset(0, 3), 4)
End If
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End SubRere
sinon comme ça
Sub TransfertVersTableau()
Dim c, i, j, Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = Sheets("Calendrier theme")
Ws.Range("C5:E35,C38:E38,I5:K35,I38:K68,O5:Q35,O38:Q68,U5:W35,U38:W68,AA5:AC35,AA38:AC68,AG5:AI35,AG38:AI68").ClearContents
For i = 2 To 32 Step 6
For j = 5 To 68
If j <> 37 Then
If IsDate(Cells(j, i)) Then
Set c = Sheets("BDD Previ").Columns(1).Find(Cells(j, i))
If Not c Is Nothing Then
Ws.Cells(j, i + 1) = VBA.Left(c.Offset(0, 1), 4)
Ws.Cells(j, i + 2) = VBA.Left(c.Offset(0, 2), 4)
Ws.Cells(j, i + 3) = VBA.Left(c.Offset(0, 3), 4)
End If
End If
End If
Next j
Next i
Application.ScreenUpdating = True
End SubBonjour
Impeccable pour les derniers code, ça marche bien. on commence sérieusement à voir la finalité.
Dernier petit soucis au niveau de la listbox double click, quand celle ci est vide ou click sur une ligne vide, il y a le message d'erreur suivant :
Erreur d'execution '380' Invalid property value.
J'ai donc essayé ça
If Me.ListBox1.ListIndex = 0 Then
MsgBox "Aucun renseignement d'inscrit.", vbOKOnly + vbInformation, "Information"
Exit Sub
End Ifmais ne marche.
Re
Je pense avoir trouvé, en tout cas ça marche.
Mon code
If Me.ListBox1.ListIndex >= 0 Then
'#Code qui affiche la selection dans les objets DTPicker1, CBx1, CBx2, CBx3
DTPicker1 = Me.ListBox1
ComboBox1 = Me.ListBox1.Column(1)
ComboBox2 = Me.ListBox1.Column(2)
ComboBox3 = Me.ListBox1.Column(3)
Me.CommandButton1.Visible = False
Me.CdBModifier.Visible = True
Else
MsgBox "Aucun renseignement sur cette ligne.", vbOKOnly + vbInformation, "Information"
Exit Sub
End Ifcdlt
Bonjour
If Me.ListBox1.ListIndex = -1 Then exit subBonjour
Ce code est nettement plus simple que le mien
après multiples essais, une petite dernière choses si je peux me permettre ? Est il possible de classer par ordre alphabétique la Combobox 1 ?
J'essai la mise en place depuis hier avec l'aide d'internet et du forum mais n't parvient pas.
Cdlt
Bonjour
Je ne comprends pas la question
C'est le combo1 ? ou le listbox
Fais une imprim ecran de ce qui n'est pas bon
A+
Re
Désolé pour mes faibles explications, oui c'est bien pour la Combo 1. c'est la dernière mise au point et serai à la finalité du projet.
J'aimerai bien si cela est possible avoir dans cette Combobox 1 les Items dans l'ordre alphabétique.
Voici les codes la concernant (dans Initialize)
Private Sub UserForm_Initialize()
Dim J As Integer
'#Mise en place des colonnes de la LitsBox1
Me.ListBox1.ColumnCount = 4
Me.ListBox1.ColumnWidths = "50;100;200;200"
'#ComboBox1
Set Ws = Sheets("Cat et thème")
Set Clients = CreateObject("Scripting.Dictionary")
With Ws
For Each Cel In .Range("A2", .[A65000].End(xlUp))
Clients(Cel.Value) = Cel.Value
Next Cel
End With
Me.ComboBox1.List = Application.Transpose(Clients.keys)
Me.ComboBox1.SetFocuset dans (Combobox1_Change)
Private Sub ComboBox1_Change() 'Catégories
Dim FirstAddress As String
Set Clients = CreateObject("Scripting.Dictionary")
Me.ComboBox2.Clear
Me.ComboBox3.Clear
Set Ws = Sheets("Cat et thème")
If Me.ComboBox1 = "" Then Exit Sub
With Ws.Columns(1)
Set Cel = .Find(Me.ComboBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do
Clients(Cel.Offset(0, 1).Value) = Cel.Offset(0, 1).Value
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
Me.ComboBox2.List = Application.Transpose(Clients.keys)
End If
End With
End SubVoici l'image aussi.
Merci.
Cdlt
Bonjour
Code de user initialise
Private Sub UserForm_Initialize()
Dim j As Integer
'#Mise en place des colonnes de la LitsBox1
Me.ListBox1.ColumnCount = 4
Me.ListBox1.ColumnWidths = "50;100;200;200"
'# Combobox 3
With Me.ComboBox3
.ColumnCount = 2
.ColumnWidths = "-1;0"
End With
'''''''''''''''''''''''''''''''''''''''
' Set Clients = CreateObject("Scripting.Dictionary")
' Set Ws = Sheets("Cat et thème")
' With Ws
' For Each Cel In .Range("A2", .[A65000].End(xlUp))
' Clients(Cel.Value) = Cel.Value
' Next Cel
' End With
' Me.ComboBox1.List = Application.Transpose(Clients.keys)
combos
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Me.ComboBox1.SetFocus
'# Initialisation des objets (date et heure)
Me.TextBox1 = Date
Me.TextBox2.Value = Format(Time, "hh:mm")
Me.DTPicker1 = Date
' BtValList
If Sheets("passage").Range("A2") <> "" Then
Alim_ListBx1 'Alimatation de la ListBox
CdBValider.Visible = True
End If
End Subpuis dans un nouveau module
Sub combos()
Dim c, combo, derligne, Plage, mondico, temp, Ws As Worksheet
Set Ws = Sheets("Cat et thème")
derligne = Ws.Range("A" & Rows.Count).End(xlUp).Row
Set Plage = Ws.Range(Ws.Cells(2, 1), Ws.Cells(derligne, 1))
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Plage
If c.Value <> "" Then mondico.Item(c.Value) = c
Next c
temp = mondico.ItemS
If mondico.Count > 0 Then
Call Tri(temp, LBound(temp), UBound(temp))
UserForm1.ComboBox1.List = temp
End If
temp = ""
End Sub
Sub Tri(a, gauc, droi)
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End SubBonjour BOB71AU
Toutes mes excuses pour cette absence, petit soucis perso.
Merci pour tes propositions qui à l'air de fonctionner mais petit soucis de chargement de la ComboBox1 à l'ouverture de UF_Previsionnel.
Je viens de mettre en place tes codes comme indiqué dans ton post précédent mais la combobox1 ne se met pas à jour à l'initialisation du UF.
J'ai essayé de mettre "Option Explicit" avant tes codes mais rien n'y fais.
Je te met le fichier original en PJ pour mieux te rendre compte, peu être. Le module ajouté s'appel "Mdl_Alpha_CbBx1".
Si j'ajoute des thèmes à l'aide du UF_thème dans la BDD et ensuite ouvre l'UF_Previsionnel, le combobox1 ne récupère pas les nouveaux thèmes.
Merci encore.
Fichier original en PJ
Bonjour
Je n'arrive pas a ouvrir le fichier joint et ne lis pas le language pictogramme
le fichier sur lequel je travail
Bonsoir BOB71AU et le forum
quand un fichier qui est plein de pictogrammes a l'ouverture direct de cjoint cela m'arrive aussi alors je l'enregistre sur le bureau pour l'ouvrir donc peut etre que si je le joint tu l'auras, ben non il est trop gros
je l'ai zipper et encore trop gros donc essai celui ci
Re BOB71AU et bonjour grisan29
grisan29 :
Merci de ton soutien pour faciliter l'ouverture du fichier (c'est vrai qu'il gros), de mon côté je suis arriver à l'ouvrir ton fichier.
BOB71AU :
Après comparaison avec ton fichier, j'ai bien la même chose mais la ComboBox1 ne s'alimente pas à l'initialisation du UF_Previsionnel, (comprend pas pourquoi !!!), si non, lorsque je retourne dans la macro (du VB) et ensuite reviens ouvrir l'UF cela fonctionne.
Idem si je ferme le fichier puis le rouvre.
Merci à vous.
Bonsoir
Je ne vois pas pourquoi
Le combo1 est vide ou non trié ?
essais
Call combosau lieu de combos
Bonsoir pompaero
j'ai essayer le fichier de bob71au et il faut ouvrir la combobox pour afficher son contenu et faire un choix puis ouvrir la 2 ème et la 3ème et cliquer sur valider liste pour que le rdv s'inscrive et mettre la date bien sur
tu referme l'userform et lors de sa réouverture le rdv enregistrer avant est listé
Re BOB71AU
moi non plus je ne vois pas pourquoi !!!
Call combos ne change rien.
Si j'ajoute des données dans feuille "Cat et thème" et ensuite ouvre UF_Previsionnel, les nouvelles données ne s'affiche pas.
Si non, elle se mettent bien dans l'ordre alphabétique.
Re
Si tu ouvre le classeur et que tu appuis sur prévision thème, le combo1 est en ordre croissant?
une ou deux petites modifs
Bonjour BOB71AU
Je viens d'effectuer quelques essais suite à tes modifs et cela à l'aire de fonctionner correctement. Il y a bien les Items qui s'affiche par ordre alphabétique.
Côté modifs j'ai juste vu dans le module Mdl_Alpha_CbBx1 que tu avais ajouté Option Compare Text (cela correspond à quoi ?) et y a t'il d'autres modifs que j'aurai loupé ?
Ensuite j'ai essayé le fonctionnement global du fichier, je n'ai pas répertorié d'erreur particulière donc je suis super content grace à toi bien sur que ça fonctionne bien.
Je pense être au bout du projet maintenant et vais donc mettre résolu avec un GRAND MERCI.
Cdlt
Bonjour
Effectivement, j'ai ajouter option compare text afin que les majuscules et les minuscules ne soient pas différenciées dans le tri du combo
j'ai également inversé les codes des boutons retour afin d'éviter le clignotement des boutons de la feuille principale
j'ai modifier le code du bouton quitter de l'user car pas d'initialisation de l'user sur me.hide ( mis unload me)
Bonne continuation
A+
Re
Ok je vais regarder à tout ça.
Je te remercie pour tout, c'est un plaisir de travailler avec toi.
Bonne continuation également
Cdlt