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 Sub
T
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