Toujours afficher userform
s
Bonjour,
J'ai besoin d'aide svp pour un pb avec des userforms, pouvez-vous svp m'éclairer sur cette situation ?
j'ai créé une userform "Menu" qui permet d'ouvrir d'autres user form :
Private Sub ComboBoxMenu_Change()
If ComboBoxMenu.Value = "Repas" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Repas Nathalie").Visible = True
Sheets("Repas Nathalie").Activate
End If
If ComboBoxMenu.Value = "Stats" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Stats repas").Activate
End If
If ComboBoxMenu.Value = "Educs" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Plannings pour educs").Visible = True
Sheets("Plannings pour educs").Activate
End If
If ComboBoxMenu.Value = "Présences FH" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Présences FH Nathalie").Visible = True
Sheets("Présences FH Nathalie").Activate
End If
If ComboBoxMenu.Value = "Nathalie" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("bilan mensuel nathalie").Visible = True
Sheets("bilan mensuel nathalie").Activate
End If
ComboBoxMenu.Value = ""
End Sub
Private Sub ComboBoxMenu1_Change()
If ComboBoxMenu1.Value = "Gestion présences" Then
UserPresencesMenu.Show
End If
If ComboBoxMenu1.Value = "Gestion repas" Then
If ActiveSheet.Name = "Stats repas" Then
UserRepas.Show
Else
MsgBox ("Vous allez être dirigé sur la feuille Stats, restez sur cette feuille SVP. Merci")
Sheets("Stats repas").Visible = True
Sheets("Stats repas").Activate
UserRepas.Show
End If
End If
If ComboBoxMenu1.Value = "Effectif d'une journée" Then
UserEffectif.Show
End If
If ComboBoxMenu1.Value = "Plage à visualiser" Then
If ActiveSheet.Name = "Stats repas" Then
UserPeriode.Show
Else
MsgBox ("pas dispo sur cette feuille")
End If
End If
ComboBoxMenu1.Value = ""
End Sub
Private Sub Enreg_Click()
ActiveWorkbook.save
End Sub
Private Sub Impr_Click()
Unload UserMenu
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
End Sub
Private Sub TBlignes_Click()
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
If ActiveSheet.Name = "Stats repas" Then
If TBlignes.Value = True Then 'bouton enfoncé
Sheets("Stats Repas").Rows("56:210").Hidden = False
Else 'bouton normal
Sheets("Stats Repas").Rows("58:64").Hidden = True
Sheets("Stats Repas").Rows("67:73").Hidden = True
Sheets("Stats Repas").Rows("76:82").Hidden = True
Sheets("Stats Repas").Rows("85:91").Hidden = True
Sheets("Stats Repas").Rows("94:100").Hidden = True
Sheets("Stats Repas").Rows("103:109").Hidden = True
Sheets("Stats Repas").Rows("112:118").Hidden = True
Sheets("Stats Repas").Rows("121:127").Hidden = True
Sheets("Stats Repas").Rows("130:136").Hidden = True
Sheets("Stats Repas").Rows("139:145").Hidden = True
Sheets("Stats Repas").Rows("148:154").Hidden = True
Sheets("Stats Repas").Rows("157:163").Hidden = True
Sheets("Stats Repas").Rows("166:172").Hidden = True
Sheets("Stats Repas").Rows("175:181").Hidden = True
Sheets("Stats Repas").Rows("184:190").Hidden = True
Sheets("Stats Repas").Rows("192:194").Hidden = True
Sheets("Stats Repas").Rows("199:201").Hidden = True
Sheets("Stats Repas").Rows("206:208").Hidden = True
Sheets("Stats Repas").Rows("197").Hidden = True
Sheets("Stats Repas").Rows("204").Hidden = True
Range("A:A").EntireColumn.Hidden = True
End If
Else
MsgBox ("pas dispo sur cette feuille")
Exit Sub
End If
For Each cmt In Sheets("Stats Repas").Comments
cmt.Shape.TextFrame.AutoSize = True
cmt.Shape.Top = Range(cmt.Parent.Address).Offset(0, 1).Top + 10
cmt.Shape.Left = Range(cmt.Parent.Address).Offset(0, 1).Left + 10
Next
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub TBrubans_Click()
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
If TBrubans.Value = True Then 'bouton enfoncé
' visibilité onglets
ActiveWindow.DisplayWorkbookTabs = False
' Barre de formule
Application.DisplayFormulaBar = False
' barre d'état
Application.DisplayStatusBar = False
' entetes lignes et colonnes
ActiveWindow.DisplayHeadings = False
' ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)"
Else 'bouton normal
' visibilité onglets
ActiveWindow.DisplayWorkbookTabs = True
' Barre de formule
Application.DisplayFormulaBar = True
' barre d'état
Application.DisplayStatusBar = True
' entetes lignes et colonnes
ActiveWindow.DisplayHeadings = True
' ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)"
End If
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
End Sub
Private Sub UserForm_Initialize()
ComboBoxMenu.RowSource = "Menu1b" ' remplit la list box des personnes
ComboBoxMenu1.RowSource = "Menu2b" ' remplit la list box des personnes
End Sub
par exemple ouvrir l'userform "UserEffectif" :
Private Sub CBvalider_Click()
Dim pens As String
Dim atel As String
Dim FH As String
Dim Abse As String
Me.Height = 400
With ThisWorkbook.Worksheets("Stats repas")
Set plage2 = ThisWorkbook.Worksheets("Stats repas").Range("f55:nr55")
For Each Cell In plage2
If Cell.Value = CDate(TextBox_Jour.Value) Then
col1 = Cell.Column
col = Mid(Cell.Address, 2, InStr(2, Cell.Address, "$") - 2)
End If
Next Cell
pens = ""
atel = ""
FH = ""
Abse = ""
Autre = ""
For i = 57 To 189 Step 9
Select Case .Cells(i, col1).Value
Case 1
atel = atel & " " & .Cells(i - 1, "B").Value & " (" & .Cells(i + 2, col1).Value & "/" & .Cells(i + 3, col1).Value & "/" & .Cells(i + 4, col1).Value & ")"
Atelier.Caption = atel
Case 2
pens = pens & " " & .Cells(i - 1, "B").Value & " (" & .Cells(i + 2, col1).Value & "/" & .Cells(i + 3, col1).Value & "/" & .Cells(i + 4, col1).Value & ")"
Pension.Caption = pens
Case Else
If .Cells(i + 1, col1).Value = "x" Then
FH = FH & " " & .Cells(i - 1, "B").Value & " (" & .Cells(i + 2, col1).Value & "/" & .Cells(i + 3, col1).Value & "/" & .Cells(i + 4, col1).Value & ")"
Repos.Caption = FH
Else
Abse = Abse & " " & .Cells(i - 1, "B").Value & " (" & .Cells(i + 2, col1).Value & "/" & .Cells(i + 3, col1).Value & "/" & .Cells(i + 4, col1).Value & ")"
Absents.Caption = Abse
End If
End Select
Next i
If .Cells(191, col1).Value = "x" Then
FH = FH & " " & .Cells(191, "B").Value & " (" & .Cells(192, col1).Value & "/" & .Cells(193, col1).Value & "/" & .Cells(194, col1).Value & ")"
Repos.Caption = FH
Else
Abse = Abse & " " & .Cells(191, "B").Value & " (" & .Cells(192, col1).Value & "/" & .Cells(193, col1).Value & "/" & .Cells(194, col1).Value & ")"
Absents.Caption = Abse
End If
If .Cells(198, col1).Value = "x" Then
FH = FH & " " & .Cells(198, "B").Value & " (" & .Cells(199, col1).Value & "/" & .Cells(200, col1).Value & "/" & .Cells(201, col1).Value & ")"
Repos.Caption = FH
Else
Abse = Abse & " " & .Cells(198, "B").Value & " (" & .Cells(199, col1).Value & "/" & .Cells(200, col1).Value & "/" & .Cells(201, col1).Value & ")"
Absents.Caption = Abse
End If
If .Cells(205, col1).Value = "x" Then
FH = FH & " " & .Cells(205, "B").Value & " (" & .Cells(206, col1).Value & "/" & .Cells(207, col1).Value & "/" & .Cells(208, col1).Value & ")"
Repos.Caption = FH
Else
Abse = Abse & " " & .Cells(205, "B").Value & " (" & .Cells(206, col1).Value & "/" & .Cells(207, col1).Value & "/" & .Cells(208, col1).Value & ")"
Absents.Caption = Abse
End If
If .Cells(236, col1).Value = "nuit" Then
Autre = Autre & " " & .Cells(230, "B").Value & " (nuit) "
Autres.Caption = Autre
End If
If .Cells(219, col1).Value = "AT" Then
Autre = Autre & " " & .Cells(212, "B").Value & " (AT) "
Autres.Caption = Autre
End If
Matin.Caption = .Cells(254, col1).Value
Soir.Caption = .Cells(255, col1).Value
End With
End Sub
Private Sub UserForm_Initialize()
TextBox_Jour = Date
Me.Height = 100
End Sub
Mais quand je quitte cet userform, l'userform Menu disparait
alors que quand j'ouvre l'userform "UserRepas" et quand je referme ce dernier l'userform "menu" est toujours présent :
Private Sub TextBoxDate_enter()
FormCalRepas.Show
End Sub
Private Sub AjoutRes_Click()
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
If TextBoxMotif.Value = "" And ComboBoxRes.Value = "" Then
a = "Indiquez la PERSONNE svp" & Chr(10) & "Indiquez le MOTIF svp"
ElseIf ComboBoxRes.Value = "" Then
a = "Indiquez la PERSONNE svp"
ElseIf TextBoxMotif.Value = "" Then
a = "Indiquez le MOTIF svp"
End If
If a <> "" Then
MsgBox a
Exit Sub
End If
With ListBoxRes
'Largeur de la ListBox
.Width = 150
'Nb Colonnes à gérer dans la ListBox
.ColumnCount = 2
'Définit la largeur de chaque colonne
.ColumnWidths = "100;50"
'Ajoute 1 ligne
For i = 0 To .ListCount - 1
If ComboBoxRes.Value = .List(i) Then
MsgBox "existe déjà"
Exit Sub
End If
Next i
.AddItem
'Idem ci-dessus mais avec d, e, f
.List(.ListCount - 1, 0) = ComboBoxRes.Value
.List(.ListCount - 1, 1) = TextBoxMotif.Value
End With
AjoutRes.Caption = "Ajouter"
ComboBoxRes.Value = ""
ListBoxRes.Value = ""
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
End Sub
Private Sub CBmodifRes_Click()
If IsNull(ListBoxRes.Value) Then
MsgBox ("pas de personne sélectionné")
Exit Sub
End If
ComboBoxRes.Value = ListBoxRes.Value
TextBoxMotif.Value = ""
ListBoxRes.RemoveItem (ListBoxRes.ListIndex)
AjoutRes.Caption = "Modifier"
End Sub
Private Sub CommandButton1_Click()
Call UserForm_Initialize
TextBoxDate.enabled = True
ComboBoxSM.enabled = True
CBquitter.enabled = True
CBquitter.Top = 35
CBquitter.Height = 20
CBquitter.Width = 66
CBquitter.Left = 192
CBouvrir.enabled = True
CBouvrir.Top = 5
Label5.Visible = False
ListBoxRes.Clear
End Sub
Private Sub CBouvrir_Click()
Dim col As String
Dim ligne As Integer
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
If TextBoxDate.Value = "" And ComboBoxSM.Value = "" Then
a = "Indiquez la DATE svp" & Chr(10) & "Indiquez le MIDI ou le SOIR svp"
ElseIf ComboBoxSM.Value = "" Then
a = "Indiquez le MIDI ou le SOIR svp"
ElseIf TextBoxDate.Value = "" Then
a = "Indiquez la DATE svp"
End If
If a <> "" Then
MsgBox a
Exit Sub
End If
Set plage2 = ThisWorkbook.Worksheets("Stats repas").Range("f55:nr55")
For Each Cell In plage2
If Cell.Value = CDate(TextBoxDate.Value) Then
col = Mid(Cell.Address, 2, InStr(2, Cell.Address, "$") - 2)
End If
Next Cell
If ComboBoxSM.Text = "Midi" Then
' résidents
For ligne = 62 To 188 Step 9 'Ajoute 1 ligne
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem
' Ajout
.List(.ListCount - 1, 0) = Cells(ligne - 6, 2)
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
' Mélanie, Frédérique et Kelvine
For ligne = 195 To 209 Step 7 'Ajoute 1 ligne
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem
' Ajout
.List(.ListCount - 1, 0) = Cells(ligne - 4, 2)
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
' salariés
For ligne = 256 To 272 Step 2 'Ajoute 1 ligne
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem
' Ajout
.List(.ListCount - 1, 0) = PremierMot(Cells(ligne, 2))
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
End If
If ComboBoxSM.Text = "Soir" Then
For ligne = 63 To 189 Step 9 'Ajoute 1 ligne Résidents dans ListBox
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem 'Idem ci-dessus mais avec d, e, f
.List(.ListCount - 1, 0) = Cells(ligne - 7, 2)
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
For ligne = 196 To 210 Step 7 'Foyer de vie
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem
' Ajout
.List(.ListCount - 1, 0) = Cells(ligne - 5, 2)
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
For ligne = 257 To 273 Step 2 'Salariés
If Range(col & ligne).Value <> "" Then
With ListBoxRes
.Width = 150 'Largeur de la ListBox
.ColumnCount = 2 'Nb Colonnes à gérer dans la ListBox
.ColumnWidths = "100;50" 'Définit la largeur de chaque colonne
.AddItem
' Ajout
.List(.ListCount - 1, 0) = Cells(ligne - 1, 2)
.List(.ListCount - 1, 1) = Range(col & ligne).Value
End With
End If
Next ligne
End If
CBouvrir.enabled = False
TextBoxDate.enabled = False
ComboBoxSM.enabled = False
Label5.Caption = "Repas du " & ComboBoxSM.Value & " du " & TextBoxDate.Value
Label5.Visible = True
TextBoxMotif.Visible = True
ComboBoxRes.Visible = True
ListBoxRes.Visible = True
Label4.Visible = True
Label3.Visible = True
AjoutRes.Visible = True
CBsuppreRes.Visible = True
CBvalider.Visible = True
Me.Height = 271
CBquitter.Top = 210
CBquitter.Left = 210
CBquitter.Height = 30
CBquitter.Width = 60
CBouvrir.Top = 5
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
End Sub
Function PremierMot$(c$)
PremierMot = Split(LTrim(c) & Space(1))(0)
End Function
Private Sub CBquitter_Click()
Unload Me
End Sub
Private Sub CBsuppreRes_Click()
Dim Plage As Range
Dim lig As Integer
Dim lettre As String
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
If IsNull(ListBoxRes.Value) Then
MsgBox ("pas de personne sélectionné")
Exit Sub
End If
' recherche nom resident dans colonne 2 de Stats repas
Set Plage = ThisWorkbook.Worksheets("Stats repas").Range("b56:b300")
For Each Cell In Plage
If Cell.Value = ListBoxRes.Value Then ' si = au nom de la liste
lig = Cell.Row ' lig = au numéro de ligne de la feuil1
End If
Next Cell
' recherche date dans ligne 4
Set plage1 = ThisWorkbook.Worksheets("Stats repas").Range("f55:nr55")
For Each Cell In plage1
If Cell.Value = CDate(TextBoxDate.Value) Then
lettre = Mid(Cell.Address, 2, InStr(2, Cell.Address, "$") - 2)
' lettre du numéro de colonne
End If
Next Cell
' si midi alors ajout valeur dans feuil1 à la bonne ligne
If lig = 191 Then ' gaillard
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData191m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData191m = sData191m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData191m = sData191m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData191m = sData191m & IIf(sData191m = "", "*", " *")
If sData191m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData191m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData191s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData191s = sData191s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData191s = sData191s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData191s = sData191s & IIf(sData191s = "", "*", " *")
If sData191s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData191s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig = 198 Then ' faure
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData198m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData198m = sData198m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData198m = sData198m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData198m = sData198m & IIf(sData198m = "", "*", " *")
If sData198m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData198m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData198s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData198s = sData198s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData198s = sData198s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData198s = sData198s & IIf(sData198s = "", "*", " *")
If sData198s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData198s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig = 205 Then ' corion
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData205m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData205m = sData205m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData205m = sData205m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData205m = sData205m & IIf(sData205m = "", "*", " *")
If sData205m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData205m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData205s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData205s = sData205s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData205s = sData205s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData205s = sData205s & IIf(sData205s = "", "*", " *")
If sData205s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData205s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig < 191 Then ' corion
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 6).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 6).Value <> "" Then sDatam = LCase(Range(lettre & lig + 6).Value)
If Range(lettre & lig + 6).Value <> "" Or Range(lettre & lig + 7).Value <> "" Then sDatam = sDatam & "-"
If Range(lettre & lig + 7).Value <> "" Then sDatam = sDatam & UCase(Range(lettre & lig + 7).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sDatam = sDatam & IIf(sDatam = "", "*", " *")
If sDatam <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sDatam
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 7).Value = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 6).Value <> "" Then sDatas = LCase(Range(lettre & lig + 6).Value)
If Range(lettre & lig + 6).Value <> "" Or Range(lettre & lig + 7).Value <> "" Then sDatas = sDatas & "-"
If Range(lettre & lig + 7).Value <> "" Then sDatas = sDatas & UCase(Range(lettre & lig + 7).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sDatas = sDatas & IIf(sDatas = "", "*", " *")
If sDatas <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sDatas
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig > 250 Then ' salariés
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig).Value = ""
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 1).Value = ""
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
' supprime valeur sélectionnée de la listbox
ListBoxRes.RemoveItem (ListBoxRes.ListIndex)
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
End Sub
Private Sub CBvalider_Click()
Dim Plage As Range
Dim lig As Integer
Dim lettre As String
' boucle sur la liste
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 0 To ListBoxRes.ListCount - 1
' recherche nom dans colonne 2 de la feuil1
Set Plage = ThisWorkbook.Worksheets("Stats repas").Range("b56:b280")
For Each Cell In Plage
If Cell.Value = ListBoxRes.List(i) Then ' si = au nom de la liste
lig = Cell.Row ' lig = au numéro de ligne de la feuil1
End If
Next Cell
' recherche date dans ligne 4
Set plage1 = ThisWorkbook.Worksheets("Stats repas").Range("f55:NR55")
For Each Cell In plage1
If Cell.Value = CDate(TextBoxDate.Value) Then
lettre = Mid(Cell.Address, 2, InStr(2, Cell.Address, "$") - 2)
' lettre du numéro de colonne
End If
Next Cell
' si midi alors ajout valeur dans feuil1 à la bonne ligne
Dim sData$
If lig = 191 Then ' gaillard
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ListBoxRes.List(i, 1)
sData191m = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData191m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData191m = sData191m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData191m = sData191m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData191m = sData191m & IIf(sData191m = "", "*", " *")
If sData191m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData191m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ListBoxRes.List(i, 1)
sData191s = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData191s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData191s = sData191s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData191s = sData191s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData191s = sData191s & IIf(sData191s = "", "*", " *")
If sData191s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData191s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig = 198 Then ' gaillard
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ListBoxRes.List(i, 1)
sData198m = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData198m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData198m = sData198m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData198m = sData198m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData198m = sData198m & IIf(sData198m = "", "*", " *")
If sData198m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData198m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ListBoxRes.List(i, 1)
sData198s = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData198s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData198s = sData198s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData198s = sData198s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData198s = sData198s & IIf(sData198s = "", "*", " *")
If sData198s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData198s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig = 205 Then ' gaillard
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig + 4).Value = ListBoxRes.List(i, 1)
sData205m = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData205m = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData205m = sData205m & "-"
If Range(lettre & lig + 5).Value <> "" Then sData205m = sData205m & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData205m = sData205m & IIf(sData205m = "", "*", " *")
If sData205m <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData205m
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 5).Value = ListBoxRes.List(i, 1)
sData205s = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 4).Value <> "" Then sData205s = LCase(Range(lettre & lig + 4).Value)
If Range(lettre & lig + 4).Value <> "" Or Range(lettre & lig + 5).Value <> "" Then sData205s = sData205s & "-"
If Range(lettre & lig + 5).Value <> "" Then sData205s = sData205s & UCase(Range(lettre & lig + 5).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sData205s = sData205s & IIf(sData205s = "", "*", " *")
If sData205s <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sData205s
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig < 191 Then ' corion
If ComboBoxSM.Text = "Midi" Then
sDatam = ""
Range(lettre & lig + 6).Value = ListBoxRes.List(i, 1)
Range(lettre & lig).ClearComments
If Range(lettre & lig + 6).Value <> "" Then sDatam = LCase(Range(lettre & lig + 6).Value)
If Range(lettre & lig + 6).Value <> "" Or Range(lettre & lig + 7).Value <> "" Then sDatam = sDatam & "-"
If Range(lettre & lig + 7).Value <> "" Then sDatam = sDatam & UCase(Range(lettre & lig + 7).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sDatam = sDatam & IIf(sDatam = "", "*", " *")
If sDatam <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sDatam
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 7).Value = ListBoxRes.List(i, 1)
sDatas = ""
Range(lettre & lig).ClearComments
If Range(lettre & lig + 6).Value <> "" Then sDatas = LCase(Range(lettre & lig + 6).Value)
If Range(lettre & lig + 6).Value <> "" Or Range(lettre & lig + 7).Value <> "" Then sDatas = sDatas & "-"
If Range(lettre & lig + 7).Value <> "" Then sDatas = sDatas & UCase(Range(lettre & lig + 7).Value)
If Not Range(lettre & lig).Comment Is Nothing Then sDatas = sDatas & IIf(sDatas = "", "*", " *")
If sDatas <> "" Then
With Range(lettre & lig)
.AddComment
.Comment.Text sDatas
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = True
End With
End If
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
If lig > 250 Then ' corion
If ComboBoxSM.Text = "Midi" Then
Range(lettre & lig).Value = ListBoxRes.List(i, 1)
End If
If ComboBoxSM.Text = "Soir" Then
Range(lettre & lig + 1).Value = ListBoxRes.List(i, 1)
End If ' si midi alors ajout valeur dans feuil1 à la bonne ligne
End If
Next i
ListBoxRes.Clear
TextBoxMotif = ""
ComboBoxRes.Value = ""
ComboBoxSM.Value = ""
CBouvrir.enabled = True
TextBoxDate.enabled = True
ComboBoxSM.enabled = True
Label5.Visible = False
TextBoxMotif.Visible = False
ComboBoxRes.Visible = False
ListBoxRes.Visible = False
Label4.Visible = False
Label3.Visible = False
AjoutRes.Visible = False
CBsuppreRes.Visible = False
CBvalider.Visible = False
Me.Height = 100
CBquitter.Top = 35
CBquitter.Height = 20
CBquitter.Width = 66
CBquitter.Left = 192
CBouvrir.Top = 5
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
ComboBoxRes.RowSource = "pers" ' remplit la list box des personnes
ComboBoxSM.Clear 'vide la liste
ComboBoxSM.AddItem "Midi" 'initialisation des elements de la liste
ComboBoxSM.AddItem "Soir" 'voila comment on rempli une combo box
TextBoxMotif.Visible = False
ComboBoxRes.Visible = False
ListBoxRes.Visible = False
Label4.Visible = False
Label3.Visible = False
AjoutRes.Visible = False
CBsuppreRes.Visible = False
CBvalider.Visible = False
Me.Height = 100
CBquitter.Top = 35
CBquitter.Height = 20
CBquitter.Width = 66
CBquitter.Left = 192
CBouvrir.Top = 5
TextBoxDate = Date
Application.ScreenUpdating = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
End Sub
Comment faire svp pour que l'userform "Menu" soit toujours présent ?
Je vous remercie beaucoup de votre aide
Cordialement
s
En redémarrant le fichier, ca marche
Comment expliquez cela svp ?
Merci de votre éclairage
Andre13Membre impliqué
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Bonjour toutes et tous
et en essayant avec Else If
Private Sub ComboBoxMenu_Change()
If ComboBoxMenu.Value = "Repas" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Repas Nathalie").Visible = True
Sheets("Repas Nathalie").Activate
Else If ComboBoxMenu.Value = "Stats" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Stats repas").Activate
Else If ComboBoxMenu.Value = "Educs" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Plannings pour educs").Visible = True
Sheets("Plannings pour educs").Activate
Else If ComboBoxMenu.Value = "Présences FH" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("Présences FH Nathalie").Visible = True
Sheets("Présences FH Nathalie").Activate
Else If ComboBoxMenu.Value = "Nathalie" Then
ActiveSheet.Visible = False
Sheets("Stats repas").Visible = True
Sheets("bilan mensuel nathalie").Visible = True
Sheets("bilan mensuel nathalie").Activate
End If
End If
End If
End If
End If
ComboBoxMenu.Value = ""
End Sub
crdlt,
André