'———————————————————————————————————————————————————————————
'Recopier la fiche navette dans la feuille du mois courant
'———————————————————————————————————————————————————————————
Const MdP$ = "MonMotDePasse"
Sub TransférerNavette()
Dim Sh_S As Worksheet, Sh_C As Worksheet, NbL As Integer, Mois$, NbFiches As Integer
Set Sh_S = ThisWorkbook.Worksheets("FICHE NAVETTE")
NbL = Sh_S.[tb_Navette].Rows.Count + 1 'Nombre de ligne de la Fiche +1 ligne intercalaire
Mois = UCase(Format(Date, "mmmm")) 'Mois en cours
Set Sh_C = ThisWorkbook.Worksheets(Mois)
With Sh_C
NbFiches = WorksheetFunction.CountIf(.UsedRange, "Documents préparés par ") 'Nombre de fiches déjà présentes pour ce Mois
Sh_S.[tb_Navette].EntireRow.Copy
.Cells(NbFiches * NbL + 1, 1).PasteSpecial Paste:=xlPasteFormats 'Pour recopier la hauteur des lignes
Sh_S.[tb_Navette].Copy
.Cells(NbFiches * NbL + 1, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(NbFiches * NbL + 1, 1).PasteSpecial Paste:=xlPasteValues 'Copie de la fiche entière sans les ChekBoxes
End With
Application.CutCopyMode = False
End Sub
Sub CkB_OUI_NON_Cliquer()
Nom = Application.Caller
Dim Wsh As Worksheet
Set Wsh = ActiveSheet
texte = "Contient des chèques bancaires & CESU : "
On Error Resume Next
Set Rg = Wsh.UsedRange.Find(What:="Contient des chèques bancaires & CESU : ", After:=ActiveSheet.Cells(1))
On Error GoTo 0
If Rg Is Nothing Then
MsgBox "Le texte ""Contient des chèques bancaires & CESU : """ & Chr(10) & "n'a pas été trouvé !"
Exit Sub
End If
Etat = Wsh.Shapes(Nom).ControlFormat.Value
Wsh.Unprotect MdP
Select Case Nom
Case "CkB_OUI"
If Etat = xlOn Then
Rg.Value = texte & "OUI"
Wsh.Shapes("CkB_NON").ControlFormat.Value = xlOff
Else
Rg.Value = texte & "NON"
Wsh.Shapes("CkB_NON").ControlFormat.Value = xlOn
End If
Case "CkB_NON"
If Etat = xlOn Then
Rg.Value = texte & "NON"
Wsh.Shapes("CkB_OUI").ControlFormat.Value = xlOff
Else
Rg.Value = texte & "OUI"
Wsh.Shapes("CkB_OUI").ControlFormat.Value = xlOn
End If
End Select
Wsh.Protect MdP
End Sub