Microsoft 365 mémo_clic fonctionnement

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

J'ai un code que m'a passé un membre du forum que je remercie au passage.
Ce code est super !!!
Il me permet d'afficher à la hauteur choisie la ligne de la cellule cliquée.
Egalement, quand je clic sur la cellule d'une autre ligne,
Il remet la ligne précédemment cliquée à la hauteur initiale
et m'affiche la nouvelle ligne cliquée à la hauteur choisie.

J'ai un gros souci cf discussion https://www.excel-downloads.com/threads/affichage-lignes-masquees-temps-de-traitement.20039711/
Ce code me permet de solutionner à 50% mon souci.

En effet, je peux quand je clique copier une ligne formatée ce qui me permet d'afficher (dans mon fichier de travail) les cellules pour qu'elle soient parfaitement lisibles,
notamment en ce qui concerne les longues annonces et nos commentaires = 50% du problème résolu


En revanche, je ne sais pas coder le retour :
C'est à dire qu'à l'affichage de la nouvelle ligne cliquée ;
Il remet la ligne précédemment cliquée à la hauteur initiale et efface ses formats (.Selection.ClearFormats)

Si vous aviez la bonne codification, ce serait super.
Je joins un fichier test.
Un super grand remerciement pour celui-là aussi :)
lionel,
 

Pièces jointes

  • memo_clic.xlsm
    20.4 KB · Affichages: 18

laurent950

XLDnaute Accro
Bonsoir : j'ai apporté un complément
Lorsque l'on clique sur la Ligne 3 le format de la ligne le formatage de la ligne sélectionner est supprimé et reviens a son état d'origine.

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

le Module a placer dans la feuille 1
VB:
' 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
 

Pièces jointes

  • memo_clic_(11) sans Userform et Module de classe.xlsm
    25.8 KB · Affichages: 6
Dernière édition:

laurent950

XLDnaute Accro
je preferais memoriser dans le sheets(x).customproperties;) c'est invisible ;)

Tu as un fichier avec un exemple, je ne connais cette méthode Patrick, C'est un peux comme la case Tag (réservé dans les objets des Userform) enfin c'est l'idée ou carrément autres choses ? et dans qu'elle cas utilisé .customproperties
si vous avez un exemple ou même une explication pour utiliser cette méthodes et pourquoi ?

Objet CustomProperties (Excel)
Liens : https://docs.microsoft.com/fr-fr/office/vba/api/excel.customproperties


exemple : L'exemple suivant illustre cette fonctionnalité. Dans cet exemple, Microsoft Excel ajoute des informations d'identificateur à la feuille de calcul active et renvoie le nom et la valeur à l'utilisateur.

VB:
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
Laurent
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re

et plus précisément dans le cadre du projet de arthour

dans cet exemple on fait exactement ce que tu fait avec tes comment ou variable type

VB:
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


perso je m'en sert pour la numerotation de devis facture automatique

et encore plus précisément comme on en utilise q'une ,on delete pas on change la valeur c'est tout

VB:
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
voili voilou ;)

ca change la vie les choses simples non?
 
Dernière édition:

laurent950

XLDnaute Accro
Merci Patrick,
J'ai compris a présent, c'est astucieux et vraiment très élégant comme code.
Name:="oldaddress", Value:=""
ici le fait d'avoir la , c'est une sorte de liste comme une Array ? disons deux dimension ? enfin cette variable
CustomProperties(1)
peux avoir plusieurs chiffre : comme CustomProperties(0) CustomProperties(1) ou CustomProperties(2) et dans chaque inclure des choses a l'intérieurs !
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
non pas vraiment c'est plutôt un espace de stokage de donnée
array non mais items oui properties(1/2/etc...)
un autre avantage par rapport a une variable c'est que si tu sauve le classeur a la prochaine ouverture si tu l'a pas deleté on le retrouve
cébolavy ;)
Name:="oldaddress", Value:=""
non c'est le nom et je met une valeur vide au depart ;)

maintenant que c'est compris fait le avec ca tu verra se sera plus facile
 

patricktoulon

XLDnaute Barbatruc
en gros si je reprends ton dernier exemple ca donne ca

VB:
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

;)

comme tu peux le voir en réfléchissant un peu on arrete de ramer avec des codes indijestes et casse tete a debuguer
 

laurent950

XLDnaute Accro
Vraiment Merci Patrick,

j'ai compris a présent et c'est vraiment un super avantage de pouvoir faire un stockage de donné en interne dans le classeur :
et dans ce classeur pouvoir réserver des donner a enregistrer dans une feuille en interne (invisible mais bien stocker) et réutilisable a la
prochaine ouverture du fichier (vraiment pas mal est super cette astuce)
Donc a faire l'exemple avec la procédure mémo clique en utilisant CustomProperties
Se soir il se fait tard mais je vais créer cela et faire le teste
A la fermeture du classeur : après enregistrement de Name:="oldaddress", Value:="" (Comme ton exemple)
de retrouver l’état initial de la précédente ligne.

je viens juste de lire votre Poste #37 c'est vraiment super efficace comme méthode que je ne connaissais pas !

http://codevba.com/excel/CustomProperty.htm#Add

Merci Laurent et vraiment super et magnifique cette astuce.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonjour arthour
la méthode je te l'ai faite en post #37 il te reste plus qu'a ajouter le unprotect et re proptect en debut et fin de macro
tu n'a besoins de rien d'autre ;)
je reprends ce soir j'ai une grosse journée aujourd'hui ;)
mais bon sang!! qui a inventé les lundi ,pendons le haut et court :p
 

Pièces jointes

  • arthour.xlsm
    16.7 KB · Affichages: 8
Dernière édition:

laurent950

XLDnaute Accro
Bonjour Patrick, lionel, le Forum,

J'ai refait le code selon le Principe de PatrickToulon, et j'ai des questions sans réponse malgré mes recherches.

Question :
1 ) ' Impossible de tester sur une valeur vide if Me.CustomProperties.Item(1).Value <> " " then ' Message = Insufisance Mémoire !
Donc Obliger d'initialisé les variables avec des valeurs "fausses"
Me.CustomProperties.Add Name:="oldaddress", Value:="init" ' Obliger de rentrer une valeur fausse / init
Me.CustomProperties.Add Name:="oldHauteur", Value:="init" ' Obliger de rentrer une valeur fausse / init

' ***********************************************************************************************************************************


2 ) Lorsque je vais initialisé mais vrais valeurs cette fois ci :
' Adresse Cible (A Consigner)
Me.CustomProperties.Item(1).Value = r.Address Ici exemple = "B2:F24" ' Ici c'est l'adresse en texte
Me.CustomProperties.Item(2).Value = r.RowHeight Ici exemple = "40 " ' Pour la hauteur de ligne en texte
Alors la question est la suivante c'est que du texte !!
j'ai essayé ceci : Mais impossible

set Me.CustomProperties.Item(1).Value = r.Address Ici exemple = Range("B2:F24") ' Ici c'est l'adresse en OBJET
Me.CustomProperties.Item(2).Value = r.RowHeight Ici exemple = "40 " ' Pour la hauteur de ligne en texte
mais rien y fait : (J'ai écrit manuellement après le .)
Me.CustomProperties.Item(1).Value.Address
Me.CustomProperties.Item(1).Value.Copy
Me.CustomProperties.Item(1).Value.Row
Il n'y a aucune option proposé après les points soit (.Address / .Copy / .Row)


' Site Ou j'ai trouvé cette application que je ne sais pas faire fonctionner :
un autres ! autres explication

encore

Alors j'ai essayer ceci : (pour une seul variable = cusprop )
Dim cusprop As CustomProperty
Dim cusprops As CustomProperties
Set cusprop = cusprops.Add(Name:="oldaddress" ,Value:=Range("B2:F24") )
et Normalement : mais impossible a faire fonctionner !!
cusprop.Address
cusprop.Copy
cusprop.Row

' ***********************************************************************************************************************************


3 ) j'ai essayer de créer une constante pour l'objet range la plage cible
' Impossible

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

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

' Conclusion
Une variable Constante pour une variable Objet ne peux pas être déclarer (Range, Worksheets, etc.)


Aussi qu'elle est la différence entre Constantante et Static ?


' Alors je suis passé comme cela :

Dim Cibleaddress As Range
Set Cibleaddress = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))

' ***********************************************************************************************************************************

Le code dans le fichier me semble assez Propre est Correcte :
C'est aussi pour lionel et aussi pour moi et bien comprendre le principe que j'ai fait le programme sous votre principe patricktoulon (J'ai fais le travail avec votre aide et exemple sur le dernier fichier joint et Poste sur le forum)

Alors patricktoulon est ce que cela est possible de parametrer cette variable CustomProperties comme une variable ou on peux stocker
autres choses que du texte (Cela dit comme c'est inscrit dans le classeur excel en rapport avec la feuille en format XSLM c'est peux être logique mais comme je découvre cette utilisation je vous pose cette question ?


Merci Patrick et lionel

Laurent
 

Pièces jointes

  • memo_clic_(12) sans Userform et Module de classe.xlsm
    29.8 KB · Affichages: 5
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
bonsoir
oulah!! doucement je viens de rentrer ;)
les données peuvent être numérique ou string c'est tout

heu.....

VB:
dim const Cibleaddress As Range
Set Cibleaddress = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))
' Impossible
c'est quoi ce dim devant const !!!!!???????????

suite:
heu .....
les constante ne peuvent être que fixe ( me.range(me.cells(......) ne l'est pas c'est une formulation
DONC NON IT S NOT POSSIBLE!!!!!!

const Cibleaddress As Range = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25)) non non non!!!!!!

ca oui!!!
Dim Cibleaddress As Range
Set Cibleaddress = Me.Range(Me.Cells(3, 2), Me.Cells(3, 25))

Attention la je suis pas sur mais je crois que l'on parle de custom properties du classeur et non ceux du sheets comme on utilises
alors en effet ca risque pas d'aboutir
mais je repete j'en suis pas sur
pour la simple et bonne raison que en tant que vieux VBSiste j'utilise le late bending (déclaration tardive )
je vais regarder ca

par exemple toi tu fait
'early binding
Dim cusprop As CustomProperty
Dim cusprops As CustomProperties

moi je fait
'latebinding
Dim cusprop As object
Dim cusprops As object
set cusprop = customproperty
etc....
mais je pense pas que ca fonctionne
c'est vrai que je maîtrise mal le early binding on va pas me refaire ;)
cela dit pour les débutants mieux vaut utiliser le early binding car on a l'autocompletion (proposition quand on code )

pour le teste vide c'est vrai ça génère une erreur de mémoire insuffisante mais on s'en fout tu met n'importe quoi au départ ;)

je vais regarder pour ca voir si c'est bien ce que je crois
 

patricktoulon

XLDnaute Barbatruc
re
@laurent950
plus haut dans la discussion j'ai bien précise "puisque ici on en utilise q'une je delete pas !!!!!

regarde pourquoi!!!
VB:
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

malheureusement si tu en veux une en particulier
il te faut boucler sur tout en interrogeant le nom pour la chopper

voila ;)
 

Discussions similaires

Statistiques des forums

Discussions
312 420
Messages
2 088 268
Membres
103 796
dernier inscrit
Adrien NCH