Où placer le bout de code?
a
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 SubT
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 !
a
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