Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13) &
Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter cette
destination à celles déjà enregistrées ?", vbYesNo + vbDefaultButton2,
"Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page, cliquer
sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable l'aperçu
avant impression de la page, cliquer sur NON.", vbYesNo, "Impression
directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" a écrit dans le message de news:... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" a écrit dans le message de news:J'ai essayé, mais le seul probléme est que l'alimentation de ma ComboBox
transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" a écrit dans le message de news:Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" a écrit dans le message de news:Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13) &
Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter cette
destination à celles déjà enregistrées ?", vbYesNo + vbDefaultButton2,
"Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page, cliquer
sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable l'aperçu
avant impression de la page, cliquer sur NON.", vbYesNo, "Impression
directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
unJ9Zi3zGHA.4972@TK2MSFTNGP03.phx.gbl...
... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
eFR11f3zGHA.2036@TK2MSFTNGP05.phx.gbl...
J'ai essayé, mais le seul probléme est que l'alimentation de ma ComboBox
transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
eUUdQX0zGHA.3304@TK2MSFTNGP05.phx.gbl...
Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OwFXehzzGHA.1288@TK2MSFTNGP03.phx.gbl...
Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
ec0p6VzzGHA.996@TK2MSFTNGP03.phx.gbl...
Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13) &
Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" & Chr(13)
& Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13) &
Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter cette
destination à celles déjà enregistrées ?", vbYesNo + vbDefaultButton2,
"Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page, cliquer
sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable l'aperçu
avant impression de la page, cliquer sur NON.", vbYesNo, "Impression
directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" a écrit dans le message de news:... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" a écrit dans le message de news:J'ai essayé, mais le seul probléme est que l'alimentation de ma ComboBox
transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" a écrit dans le message de news:Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" a écrit dans le message de news:Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
Visiblement il y aurait deux listes destination_ComboBox et
enregistre_Combobox
Pour que cela fonctionne il faut ainsi renommer celle que tu adaptes en
ListBox
et modifier les occurences de l'expression correspondante dans le code.Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
classeur).
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:
%Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13)
& Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des
autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter
cette destination à celles déjà enregistrées ?", vbYesNo +
vbDefaultButton2, "Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page,
cliquer sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable
l'aperçu avant impression de la page, cliquer sur NON.", vbYesNo,
"Impression directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" a écrit dans le message de news:... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" a écrit dans le message de news:J'ai essayé, mais le seul probléme est que l'alimentation de ma
ComboBox transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" a écrit dans le message de news:Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" a écrit dans le message de news:Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
Visiblement il y aurait deux listes destination_ComboBox et
enregistre_Combobox
Pour que cela fonctionne il faut ainsi renommer celle que tu adaptes en
ListBox
et modifier les occurences de l'expression correspondante dans le code.
Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
classeur).
Cordialement.
lSteph
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
%23YddUv3zGHA.5072@TK2MSFTNGP03.phx.gbl...
Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13)
& Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des
autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter
cette destination à celles déjà enregistrées ?", vbYesNo +
vbDefaultButton2, "Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page,
cliquer sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable
l'aperçu avant impression de la page, cliquer sur NON.", vbYesNo,
"Impression directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
unJ9Zi3zGHA.4972@TK2MSFTNGP03.phx.gbl...
... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
eFR11f3zGHA.2036@TK2MSFTNGP05.phx.gbl...
J'ai essayé, mais le seul probléme est que l'alimentation de ma
ComboBox transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
eUUdQX0zGHA.3304@TK2MSFTNGP05.phx.gbl...
Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" <lecocosteph@frite.fr> a écrit dans le message de news:
OwFXehzzGHA.1288@TK2MSFTNGP03.phx.gbl...
Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" <awerel2006@neuf.fr> a écrit dans le message de news:
ec0p6VzzGHA.996@TK2MSFTNGP03.phx.gbl...
Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
Visiblement il y aurait deux listes destination_ComboBox et
enregistre_Combobox
Pour que cela fonctionne il faut ainsi renommer celle que tu adaptes en
ListBox
et modifier les occurences de l'expression correspondante dans le code.Je ne sais comment rectifier le tir ?
(Comptons bien à l'évidence que tu fais tes essais sur une copie de ton
classeur).
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:
%Voici le reste du code ; ce que j'avais transmis était dans
Userform_Initialise...
J'ai peur que cela ne soit pas ce que vous attendiez ?
Si nécessaire, je peux mettre le fichier en Cjoint...
Antoine
Option Explicit
Dim reponse_fermeture As Byte, a As Byte
Private Sub deja_enregistre_Button_Click()
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
ElseIf LCase(date_retour_TextBox) = "open" Then
[E8] = CStr(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom du salarié et son numéro SS
If enregistre_ComboBox <> "" Then
[A8] = enregistre_ComboBox
[B8] = Range("gmci_7").Offset(enregistre_ComboBox.ListIndex, 1)
Else
MsgBox ("Merci de bien vouloir sélectionner un salarié dans la
liste")
Exit Sub
End If
' appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub jamais_enregistre_Button_Click()
Dim enregistrement_nouveau_salarie As Byte
' paramètre la désactivation de fermeture du formulaire
reponse_fermeture = 0
' valide la date de départ en D8
If date_depart_TextBox <> "" And IsDate(date_depart_TextBox) = True
Then
[D8] = CDate(date_depart_TextBox)
Else
MsgBox ("Le format de la date de départ est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide la date de retour en E8
If date_retour_TextBox <> "" And IsDate(date_retour_TextBox) = True
Then
[E8] = CDate(date_retour_TextBox)
Else
MsgBox ("Le format de la date de retour est non valide" & Chr(13)
& Chr(13) & "Entrer de nouveau une date , mais valide !")
Exit Sub
End If
' valide l'antériorité de la date de départ /date de retour
If [E8] < [D8] Then
MsgBox ("Date de retour antérieure à la date de départ :" &
Chr(13) & Chr(13) & "Corriger les dates erronées.")
Exit Sub
End If
' valide la destination
If destination_ComboBox <> "" And IsDate(destination_ComboBox) = False
Then
[C8] = Application.WorksheetFunction.Proper(destination_ComboBox)
Else
MsgBox ("La destination n'est pas valide." & Chr(13) & Chr(13) &
"Entrer la destination.")
Exit Sub
End If
' valide le nom et le prénom en A8
If nom_TextBox <> "" And IsNumeric(nom_TextBox) = False _
And prenom_TextBox <> "" And IsDate(prenom_TextBox) = False Then
[A8] = UCase(nom_TextBox) & " " &
Application.WorksheetFunction.Proper(prenom_TextBox)
Else
MsgBox ("Les nom/prénom du salarié ne sont pas valides" & Chr(13)
& Chr(13) & "Entrer de nouveau les nom/prénom.")
Exit Sub
End If
' valide le numéro SS
If numero_ss_TextBox <> "" Then
' supprime les espaces et les /
[B8] =
Application.WorksheetFunction.Substitute(Application.WorksheetFunction.Substitute(numero_ss_TextBox,
" ", ""), "/", "")
Else
MsgBox ("Le numéro SS n'est pas valide." & Chr(13) & Chr(13) &
"Entrer un numéro SS valide.")
Exit Sub
End If
' demande pour enregistrer le nouveau salarié
enregistrement_nouveau_salarie = MsgBox("Faut-il sauvegarder dans le
listing les données concernant ce salarié ?", vbYesNo + vbDefaultButton2,
"Enregistrement des données de ce nouveau salarié avec celles des
autres")
If enregistrement_nouveau_salarie = 6 Then
[A65536].End(xlUp).Offset(1) = Range("A8").Value
[A65536].End(xlUp).Offset(, 1) = Range("B8").Value
' classe les salariés enregistrés selon les noms
Range(Range("gmci_7"), [A65536].End(xlUp).Offset(, 1)).Select
Selection.Sort key1:=Range("gmci_7"), order1:=xlAscending
Range("A8").Select
End If
'appelle le programme d'impression de fermeture du formulaire
Unload formulaire_nouvelle_mission
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub UserForm_Initialize()
' paramètre l'activation de fermeture du formulaire
reponse_fermeture = 1
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
End Sub
Private Sub UserForm_Terminate()
Dim numero_SS As String, reponse_impression As Byte,
enregistrement_nouvelle_destination As String
Dim Sh As Worksheet, longueur As Byte
' supprime l'activation des macros évènementielles
Application.EnableEvents = False
' vérifie si l'on doit fermer sans imprimer
If reponse_fermeture = 1 Then
' déplace les 2 cellules de N° de contrat
Range("J8:K8").Cut Destination:=Range("L7:M7")
' insère la ligne et la déverrouille
Rows("8").Delete
' déplace les 2 cellules de N° de contrat
Range("L7:M7").Cut Destination:=Range("J8:K8")
' réactive la protection du fichier
ActiveSheet.Protect , True, True, True
Range("A8").Select
Exit Sub
End If
' met les N° SS du tableau et de la liste à un format adapté au nombre
de chiffres
For a = Range("gmci_1").Row To [A65536].End(xlUp).Row
With Cells(a, 2)
Select Case Len(.Value)
Case 1
.NumberFormat = "#"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""#"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
Case Else
End Select
End With
Next
' initialise la boucle de recherche du lieu dans la liste
Set Sh = Sheets("Sommaire")
With Sh
For a = 1 To Sh.[L65536].End(xlUp).Row
If destination_ComboBox = Sh.Cells(a, 12).Value Then
' évite le transfert du lieu et le classement des lieux
GoTo saute
End If
Next a
' ajoute la destination aux destinations déjà enregistrées
enregistrement_nouvelle_destination = MsgBox("Faut-il ajouter
cette destination à celles déjà enregistrées ?", vbYesNo +
vbDefaultButton2, "Enregistrement de cette nouvelle destination")
If enregistrement_nouvelle_destination = 6 Then
Sh.[L65536].End(xlUp).Offset(1) =
Application.WorksheetFunction.Proper(destination_ComboBox.Value)
With .Range("L1:L" & .Range("L65536").End(xlUp).Row)
.Sort key1:=Sh.Range("L1"), order1:=xlAscending,
Header:=xlNo
Range("L1").Select
End With
End If
End With
saute:
' copie la ligne du salarié ou TNS
Rows("8").Copy Destination:=Rows("1")
' copie le 1er jour du trimestre en F1
[F1] = [A2]
' copie le bloc des données de la société en ligne 1
[G1] = [K2]
[H1] = [K3]
[I1] = [K4]
[J1] = [K5]
[K1] = [K6]
[L1] = [K7]
[M1] = [K8]
' enregistre le nom du fichier GMCI et de la feille en N1 et O1
[N1] = ActiveWorkbook.Name
[O1] = ActiveSheet.Name
' masque les lignes 1 à 2
Rows("1:2").Hidden = True
' copie la ligne de mission/société
Rows("1").Copy
' va sur la feuille Fax mission
Feuil3.Select
' colle la ligne mission/société sur la ligne 1 et masque 1 à 2
Rows("1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:2").Hidden = True
' copie la feuille
Cells.Copy
' ouvre un nouveau fichier
Workbooks.Add
' colle sur la feuille
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
' met le N° au format SS selon le nombre de chiffres
With Range("E32")
Select Case Len(.Value)
Case 1
.NumberFormat = "0"
Case 2
.NumberFormat = "#"" ""#"
Case 3
.NumberFormat = "#"" ""##"
Case 4
.NumberFormat = "#"" ""##"" ""#"
Case 5
.NumberFormat = "#"" ""##"" ""##"
Case 6
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 7
.NumberFormat = "#"" ""##"" ""##"" ""##"
Case 8
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""#"
Case 9
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""##"
Case 10
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"
Case 11
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""#"
Case 12
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""##"
Case 13
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"
Case 14
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""#"
Case 15
.NumberFormat = "#"" ""##"" ""##"" ""##"" ""###"" ""###"" /
""##"
End Select
End With
' fait la mise en page de la nouvelle feuille
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PageSetup.PrintArea = "$A$3:F46"
' masque les lignes de changement de mission
Rows("34").Hidden = True
Rows("37").Hidden = True
Rows("40").Hidden = True
' demande si impression directe ou aperçu avant impression préalable
reponse_impression = MsgBox("Pour imprimer directement la page,
cliquer sur OUI." & Chr(13) & Chr(13) & "Pour visualiser au préalable
l'aperçu avant impression de la page, cliquer sur NON.", vbYesNo,
"Impression directe ou apreçu de la page ?")
If reponse_impression = vbYes Then
' met le nom du fichier GMCI et de la feuille en variable
Dim nom_fichier_gmci As String, nom_feuille_gmci As String
nom_fichier_gmci = Range("N1").Value
nom_feuille_gmci = Range("O1").Value
' imprime la page de fax
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1,
Collate:=True
' ActiveWindow.SelectedSheets.PrintPreview
' ferme le fichier à imprimer
ActiveWorkbook.Close savechanges:úlse
' retourne sur la feuille de notre client
Workbooks(nom_fichier_gmci).Activate
' classe les missions selon les noms, puis les dates de départ
Sheets(nom_feuille_gmci).Select
Range("A8:gmci_3").Select
Selection.Sort _
key1:=Range("A8"), order1:=xlAscending, _
key2:=Range("D8"), order2:=xlAscending, _
key3:=Range("E8"), order3:=xlAscending
Range("A8").Select
' reprotège le fichier GMCI
ActiveWorkbook.Sheets(nom_feuille_gmci).Select
ActiveSheet.Protect , True, True, True
' enregistre les modifications du fichier GMCI
ActiveWorkbook.Save
Else
' copie la feuille sans les formules
Range("A1:U46").Select
Selection = Selection.Value
' affiche la ligne 2
Rows("2").Hidden = False
' fait un fractionnement de la page
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
' affiche l'aperçu de la feuille
ActiveWindow.SelectedSheets.PrintPreview
End If
' réactive les macros évènementielles
Application.EnableEvents = True
End Sub
"lSteph" a écrit dans le message de news:... il faudrait le reste du code: > destination_ListBox?? >
enregistre_ListBox.??
"Antoine" a écrit dans le message de news:J'ai essayé, mais le seul probléme est que l'alimentation de ma
ComboBox transformé en ListBox ne fonctionne plus !
Ci-joint le code :
' met dans la ComboBox de destination les salariés déjà
pré-enregistrées
destination_ListBox.RowSource = "Sommaire!L1:" &
Sheets("Sommaire").[L65536].End(xlUp).Address
' met dans la ComboBox de noms les salariés déjà pré-enregistrées
enregistre_ListBox.RowSource = Range(Range("gmci_7"),
[A65536].End(xlUp)).Address
Je ne sais comment rectifier le tir ?
Merci à vous
Antoine
"Antoine" a écrit dans le message de news:Bonjour,
Je ne suis pas sûr de comprendre ce que tu veux dire : ce que j'ai
c'est une Combo Box que j'ai et qui est alimentée par tout une colonne
d'une feuille. La liste est assez longue ; c'est pourquoi j'aurai aimé
activer un "scroll"... ?
Mais peut-être cela n'est-il pas compatible ?
Antoine
"lSteph" a écrit dans le message de news:Bonjour,
C'est une Listbox qui ressemble à cela.
Cordialement.
lSteph
"Antoine" a écrit dans le message de news:Bonjour à tous
Je souhaiterai qu'il soit possible de faire défiler "l'échelle" les
différéentes valeurs proposées par une ComboBox pour une sélection
plus aisée. Cela est-il possible ? et si oui...
Merci à tous
Antoine
