Microsoft 365 mémo_clic fonctionnement

' Bouton : Active code
Sub active()
Application.EnableEvents = True
End Sub
'Bouton : Desactive code
Sub desactive()
ActiveSheet.Unprotect Password:=""
Application.EnableEvents = False
End Sub

' Garde en Mémoire :
Private Type Coordonnee
' l'origine : (0rig_ La ligne avant modification)
    Orig_Adresse As Range
    Orig_Hauteur As String
' La ligne Cible : (Cible_ Celle qui a les formats a dupliquer)
    Cible_Adress As Range
End Type
Private MaPlage As Coordonnee
Private Sub Worksheet_SelectionChange(ByVal r As Range)
' Depart
    ActiveSheet.Unprotect Password:=""
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'
' Test si c'est la igne cible chosie (sortie de la procédure)
    If r.Row = 3 Then
        Sortie        ' Si on clique sur la ligne 3 (La précédente ligne est remise en forme Origine et dechargement variable Type)
        Exit Sub      ' Sortie de procédure
    End If
'
' conserve le format de la ligne 3 colonne A3:Y3
    Set MaPlage.Cible_Adress = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))
'
' test si la variable type est vide pour la hauteur de ligne
' si différente de vide la hauteur de la ligne et format précédent seront remis comme précédement
    If MaPlage.Orig_Hauteur <> Empty Then
         MaPlage.Orig_Adresse.RowHeight = MaPlage.Orig_Hauteur
         MaPlage.Orig_Adresse.EntireRow.ClearFormats
    End If
'
' Ligne d'origine à mémoriser : dans la variable Type en haut de Module (en fin de procédure information conservé)
'   Adresse de la ligne / ChoixLign.Address
        Set MaPlage.Orig_Adresse = r
'   Hauteur de ligne / ChoixLign.Height
        MaPlage.Orig_Hauteur = r.RowHeight
'
'   Mise en forme de la ligne choisie (en fonction d'un formatage prédéfinie ici ligne N°3 colonnes 2 à 25)
'   Ligne choisie Affiche ligne hauteur 40 (Selon Votre choix)
        r.RowHeight = 40
' Copier le Format
        MaPlage.Cible_Adress.Copy
        Me.Range(Me.Cells(MaPlage.Orig_Adresse.Row, 2), Me.Cells(MaPlage.Orig_Adresse.Row, 25)).PasteSpecial Paste:=xlPasteFormats
        Me.Application.CutCopyMode = False
'
' Fin
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.EnableEvents = True
    Application.ScreenUpdating = True
'
End Sub
Sub Sortie()
' Remise en forme de la ligne selectionné (comme d'origine)
' Pour cela il faut cliqué sur la Ligne N°3
     ' si choix de la ligne 3 remise au format de la précedente ligne.
        If MaPlage.Orig_Hauteur <> Empty Then
             MaPlage.Orig_Adresse.RowHeight = MaPlage.Orig_Hauteur  ' Remise en forme bonne hauteur
             MaPlage.Orig_Adresse.EntireRow.ClearFormats            ' Suprime le Format
             Set Coordonnee = Nothing                               ' Decharge la variable type
        End If
' Fin
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub CheckCustomProperties()   

Dim wksSheet1 As Worksheet   
    Set wksSheet1 = Application.ActiveSheet   

' Add metadata to worksheet.  (La virgule je connais pas ! entre "Market", Value:)
    wksSheet1.CustomProperties.Add Name:="Market", Value:="Nasdaq"   

' Display metadata.  (C'est une sorte de tableau ou Variable Type pour (Name et Value) / CustomProperties.Item(1) 
' il peux avoir CustomProperties.Item(2) et CustomProperties.Item(3) etc ? 
With wksSheet1.CustomProperties.Item(1)  
    MsgBox .Name & vbTab & .Value  
End With  
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveSheet.CustomProperties.Count = 0 Then
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=""
Else
MsgBox " la precedente etait la " & ActiveSheet.CustomProperties(1).Value
ActiveSheet.CustomProperties(1).Delete
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=Target.Address(0, 0)
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveSheet.CustomProperties.Count = 0 Then
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=""
Else
MsgBox " la precedente etait la " & ActiveSheet.CustomProperties(1).Value
ActiveSheet.CustomProperties(1).Value = Target.Address(0, 0)
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If ActiveSheet.CustomProperties.Count = 0 Then
        ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=""
    Else
        With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With
        ActiveSheet.CustomProperties(1).Value = Target.Address(0, 0)
        Cells(3, 2).Resize(, 23).Copy
        With Cells(Target.Row, 2).Resize(, 23): .PasteSpecial Paste:=xlPasteFormats: .RowHeight = 40: End With
    End If
    Application.CutCopyMode = False
End Sub

dim const Cibleaddress As Range
Set Cibleaddress = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))
' Impossible

Sub test()
ActiveSheet.CustomProperties.Add Name:="toto", Value:="truc"
ActiveSheet.CustomProperties.Add Name:="titi", Value:="machin"
ActiveSheet.CustomProperties.Add Name:="rififi", Value:="bidule"

For Each customprp In ActiveSheet.CustomProperties
Debug.Print "name: " & customprp.Name & " value " & customprp.Value
Next
Debug.Print "la premiere est " & ActiveSheet.CustomProperties(1).Name & " A BEN CA ALORS !!!!"
'Debug.Print "la valeur de toto est " & ActiveSheet.CustomProperties("toto").Value ' on ne peux y aceder par le nom dans les parenthezes !!!!!
End Sub

Sub testsuppr() 'pour supprimer toute les prop custom avant de relancer la sub test
For Each customprp In ActiveSheet.CustomProperties
customprp.Delete
Next

End Sub