Où placer le bout de code?

Bonjour le forum

Il y a 2 jours j'ai trouvé ce bout de code qui fonctionne super dans plusieurs programme mais dans un ça ne veut pas

Où mettre ce bout de code dans ces macros?

Merci à vous

Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
        Split(Sh.Name, " ")(0), vbTextCompare) Then
       ActiveWindow.ScrollRow = 1
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  ActiveSheet.Range("A1").Select

End Sub

Private Sub Workbook_Open()
Dim wSheet As Worksheet
Dim Feuille As String, AMasquer As String
Dim I As Integer

 Application.ScreenUpdating = False
  For Each wSheet In Worksheets
    wSheet.Protect UserInterfaceOnly:=True
  Next wSheet

  Feuille = MonthName(Month(Date)) & " " & Year(Date)
  If FeuilleExiste(Feuille) = False Then Exit Sub
  If UCase(Feuille) <> UCase(ActiveSheet.Name) Then
      ' Teste le nom en majuscule de la feuille du mois en cours avec le nom en majuscule de la feuille affichée
    AMasquer = ActiveSheet.Name
    With Sheets(Feuille)
      .Visible = True
      .Select
    End With
    Sheets(AMasquer).Visible = xlSheetVeryHidden
  End If

  For I = 1 To Sheets.Count
    If UCase(Sheets(I).Name) <> UCase(Feuille) Then Sheets(I).Visible = xlSheetVeryHidden
  Next I

  If Time > TimeSerial(12, 0, 0) Then
    Sheets(Feuille).Range("C" & 5 + Day(Date)) = 3
  Else
    Sheets(Feuille).Range("B" & 5 + Day(Date)) = 3
  End If
  Sheets(Feuille).Range("B" & 5 + Day(Date)).Resize(1, 2).HorizontalAlignment = xlCenter

End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String

  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ' On recherche si la page est surveillée
  If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
              Split(Sh.Name, " ")(0), vbTextCompare) Then
    ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
    NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
    If Target.Row - 5 > Day(Date) Then
      Beep
      MsgBox "PAS LE BON JOUR"
      Target = ""
    Else
      ' Surveille la plage du 1er au dernier jours du mois
      If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
        ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
        Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
        ' Si la colonne B et la colonne C est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)

        ' si la ligne modifiée est la dernière du mois et que la colonne est la C
        If Target.Row = NombreJour + 5 And Target.Column = 3 Then
          ' On construit le nom de la feuille du mois suivant
          MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
          ' On va vérifier si la feuille existe
          If FeuilleExiste(MoisSuivant) = False Then Exit Sub
          ' La feuille existe
          With Sheets(MoisSuivant)
            'On la rend visible
            .Visible = xlSheetVisible
            ' On masque celle que l'on vient de finir
            ActiveSheet.Visible = xlSheetHidden
            ' et on la sélectionne
            .Select
          End With
        End If
      End If
    End If
  End If
  Application.EnableEvents = True
End Sub
Function FeuilleExiste(Nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

Sub ret()
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, [A2:A8]) Is Nothing Then Exit Sub
  If Not Target.Comment Is Nothing Then AfficherMasquerDistanceMoisPrecedent
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim Obj As Shape, Ligne As Long

  If UCase(Sh.Name) <> "MENU" And Target.Count = 1 And Target.Column = 2 And Target.Row > 5 Then
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect

    For Each Obj In ActiveSheet.Shapes
      If InStr(1, Obj.TextFrame.Characters.Text, "Centrer Texte", vbTextCompare) > 0 Then Exit For
    Next Obj

    If Not Obj Is Nothing Then
      Ligne = Target.Row     'Cette ligne pour Centrer ou Annuler Texte sur Plusieurs colonnes (B & C)et toutes les lignes du mois et non la dernière ligne active du jour

      With Obj.TextFrame
        If Range("B" & Ligne).HorizontalAlignment = xlCenterAcrossSelection Then
          .Characters.Text = "Annuler Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
          .Characters(Start:=23, Length:=22).Font.ColorIndex = 5
        Else
          .Characters.Text = "Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
          .Characters(Start:=15, Length:=22).Font.ColorIndex = 5
        End If
      End With
    End If
    ActiveSheet.Protect
  End If
End Sub

Bonjour,

Les procédures que tu nous montres sont des procédures événementielles propres au classeur donc, elles doivent être mises dans le module de ce dernier à savoir le module ThisWorkbook !

Bonjour Theze et encore merci pour hier

Oui les macros sont bien c'est dans ThisWorkbook

Il faut que ça concerne que la colonne A

Merci à toi

Rechercher des sujets similaires à "placer bout code"