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

patricktoulon

XLDnaute Barbatruc
re
oulalah non!!!!
for each customprop in activesheet.customproperties ne tourne pas a reculons
for each =elle tourne tant qu'il y a des elements(JUSQU AU .COUNT!!!)

for i =.count to 1 =tourne a reculons

for i = 1 to .count = tourne a l'endroit du 1er au dernier


tu veux me faire disjonter toi hein !! :p :p :p :p
 

patricktoulon

XLDnaute Barbatruc
oui VBA est un des rares language ou la boucle for each est a precié
en javascript par exemple elle est dépréciée vu que l'ecoute sur les éléments est sur les collections(d elements) on a un phénomène d'event,propagation

alors c'est vrai que codant en Js vb vba vbs et maintenant vb.net des fois je perds le pédales ;)
 

patricktoulon

XLDnaute Barbatruc
re
allez une derniere
si tu cherche une customproperties par son nom fait toi une petite fonction simple toute bête

getProperties [le sheet]s] , [le nom]


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 !!!!"
    Set mytoto = getProperties(ActiveSheet, "toto")
    If Not mytoto Is Nothing Then Debug.Print "la valeur de toto est """ & getProperties(ActiveSheet, "toto").Value & """"
   
    
    
    'Debug.Print "la valeur de toto est " & ActiveSheet.CustomProperties("toto").Value ' on ne peux y aceder par le nom dans les parenthezes !!!!!
End Sub

Function getProperties(ByRef sh As Worksheet, ByVal nom As String)
Dim customprp As Object
Set getProperties = Nothing
For Each customprp In sh.CustomProperties
If customprp.Name = nom Then Set getProperties = customprp: Exit For
Next
End Function


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

laurent950

XLDnaute Accro
alors c'est vrai que codant en Js vb vba vbs et maintenant vb.net
Vous avez des gr
ByRef sh As Worksheet, ByVal nom As String
patrick C'est l'iverse
ByVal sh As Worksheet, ByRef nom As String

ByVal = Pour variable Objet
ByRef = Pour variable simple Natif non objet
  • ByRef”, implique qu’une référence à l’élément passé à la procédure est conservée, et que cet élément peut être modifié par la fonction
  • ByVal signifie au contraire que lors de la passation d’un argument, celui-ci est évalué, et que seule sa valeur est prise en compte. Il en résulte que l’élément passé à la procédure ne peut être modifié par celle-ci.
Dranreb (Merci) Poste #25
Dranred m'avais aidé sur se sujet j'ai le fil de la discussion

Laurent
 
Dernière édition:

laurent950

XLDnaute Accro
Set mytoto = getProperties(ActiveSheet, "toto")
J'ai compris le Set avec la fonction c'est extra.
Set mytoto = getProperties(ActiveSheet, "toto")

et aussi la fonction Merci.
Dim customprp As Object qui fonctionne avec les collections = OK

Super Merci j'ai compris le principe plus cas essayer d'en créer une par moi même.

Je consigne votre code pour que je puisse en refaire un par moi même et pas perdre la trace dans se fils très copieux

LE CODE CI DESSOUS A ETAIT ECRIT ET FAIT PAR PATRICKTOULON
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 !!!!"
    Set mytoto = getProperties(ActiveSheet, "toto")
    If Not mytoto Is Nothing Then Debug.Print "la valeur de toto est """ & getProperties(ActiveSheet, "toto").Value & """"
   
    'Debug.Print "la valeur de toto est " & ActiveSheet.CustomProperties("toto").Value ' on ne peux y aceder par le nom dans les parenthezes !!!!!
End Sub

Function getProperties(ByRef sh As Worksheet, ByVal nom As String)
Dim customprp As Object
Set getProperties = Nothing
For Each customprp In sh.CustomProperties
If customprp.Name = nom Then Set getProperties = customprp: Exit For
Next
End Function

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

Je le consigne et le conserver, j'ai compris super
Merci Patrick
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re

DistinctionsDistinctions
Lors du passage d’un argument à une procédure, tenez compte de plusieurs différences différentes qui interagissent entre elles :When passing an argument to a procedure, be aware of several different distinctions that interact with each other:
  • Si l’élément de programmation sous-jacent est modifiable ou non modifiableWhether the underlying programming element is modifiable or nonmodifiable
  • Si l’argument lui-même est modifiable ou non modifiableWhether the argument itself is modifiable or nonmodifiable
  • Si l’argument est passé par valeur ou par référenceWhether the argument is being passed by value or by reference
  • Si le type de données de l’argument est un type valeur ou un type référenceWhether the argument data type is a value type or a reference type
Pour plus d’informations, consultez différences entre les arguments modifiables et non modifiables et les différences entre le passage d’un argument par valeur et par référence
 

patricktoulon

XLDnaute Barbatruc
re
set parce que les customproperties sont des object
des object qui ont deux propriété(name et value)
set c'est pour instancier un object et rien d'autre ;)

exemple
set mytoto=activesheet.customproperties(1)
mavaleurtoto=activesheet.customproperties(1).value
custmompropname1=activesheet.customproperties(1).name

comme mytoto a été instancié on peut faire

mavaleurtoto=mytoto.value
custmompropname1=mytoto.name
 

laurent950

XLDnaute Accro
Merci Pour ces deux eplications :

le Poste #68 ca va j'arrive a suivre

Pour le poste #67 je vais étudier cela de plus près (mais je pense avoir a peux près compris)
l'idée est :
VB:
' Dans cet exemple Montant 10 n’est pas modifié avec ByVal (Montant Reste 10 dans Sub Calcul1)              
Sub Calcul1()
Dim Montant As Integer
Montant = 10
Produit1 Montant, 2
MsgBox "Montant = " & Montant, 32
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub Produit1(ByVal Nb As Integer, N As Integer)
Nb = Nb * N
End Sub

et

VB:
'Dans cet exemple Montant 10 est modifier avec ByRef(Montant Devient 20 dans Sub Calcul2)
Sub Calcul2()
Dim Montant As Integer
Montant = 10
Produit2 Montant, 2
MsgBox "Montant = " & Montant, 32
End Sub
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub Produit2(ByRef Nb As Integer, n As Integer)
Nb = Nb * n
End Sub

Pour l'idée, mais je vais me concentrer sur les objets

Merci Patrick
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Patrick, Laurent, le Forum,

Patrick et Laurent,
Formidable travail que vous faites :)
Je ne manque pas vos échanges.
Mais je suis "largué" et je n'y comprends rien. Mon niveau ne me le permet pas :(
Quel courage, quel précision, quel sérieux.

Je vous remercie vraiment :)
Bonne journée (LOL Patrick on n'est plus lundi :))
lionel,
 

patricktoulon

XLDnaute Barbatruc
re
bonsoir tout les deux
Bon alors lionel tu a ce que tu veux ou pas :p :cool:
bon c'est vrai on c'est un peu emballé avec laurent mais bon j'ai pensé qu'il fallait rectifier certaines idées préconçu au niveau des boucle a laurent car c'est vrai que quand on les testes pas dans diverses conditions on peut interpréter une méthode d'une façon qui n'est pas ,ça m'est arrivé plus d'une fois

remet le code commenté au cas ou
les commentaires sont simples et a leur lectures les choses deviennent plus simples

VB:
'je commente je commente :)

'a la fermeture du classeur on clear la derniere qui a été cliquée
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveSheet.Unprotect Password:="" 'je leve la protection
    Application.EnableEvents = False ' j'inhibe les evenements
    Application.ScreenUpdating = False 'j'inhibe le raffraichissement de l'ecran

    If ActiveSheet.CustomProperties.Count > 0 Then 'si il n'y a une  custom properties
        With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With ' on  clearformats le range (la valeur de la custompropertie)
        ActiveSheet.CustomProperties(1).Delete ' je supprime la custom propertie
    End If

    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True ' on re protege
    ActiveSheet.EnableSelection = xlNoRestrictions ' toute restriction bye bye!!!
    Application.EnableEvents = True 'on déinhibe les evenement
    Application.ScreenUpdating = True ' on réactive le rafraichissement de l'ecran
End Sub

'au click sur cellule maintenant
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Feuil1" Then ' on veux que ca fonctionne que sur feuil1
        ' Depart
        ActiveSheet.Unprotect Password:="" 'je leve la protection
        Application.ScreenUpdating = False 'j'inhibe le raffraichissement de l'ecran
        If ActiveSheet.CustomProperties.Count = 0 Then 'si il n'y a une  custom properties
            ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=Target.Address(0, 0) ' on memorise la target active(activecell)
         Cells(3, 2).Resize(, 24).Copy 'on copy la ligne 3
            With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With 'on paste le format
      
        Else ' sil y a bien une custom !!!
            With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With ' on  clearformats le range (la valeur de la custompropertie)
            ActiveSheet.CustomProperties(1).Value = Target.Address(0, 0) ' on change l'adress dans la customproperties
            Cells(3, 2).Resize(, 24).Copy 'on copy la ligne 3
            With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With 'on paste le format
        End If
        Application.CutCopyMode = False ' on arrete le copypaste


        ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True 'on reprotege
        ActiveSheet.EnableSelection = xlNoRestrictions ' toute restriction bye bye!!!
        Application.ScreenUpdating = True ' on réactive le rafraichissement de l'ecran
    End If
End Sub

;)
 

laurent950

XLDnaute Accro
Bonjour Patrick, Lionel, Le Forum.

Alors Entre mes boucles et la variable "CustomProperties" à Patrick tu vas avoir le tournis Lionel :):) à défaut d'avoir la "mémoire insuffisante" hi hi :p:p

Le Choix est surement compliqué, mais la procédure à Patrick est vraiment EXCEL-ENTE :D:D (C'est le bon choix) mais il faut avoir une bonne mémoire ha ha ha :p:p:p.

Aussi tu peux garder mes exemples, avec mes boucles et mes modules avec (Variable Type, Module de Classe, Stockage dans Commentaire, Etc?, ...) C'est là class hi hi :rolleyes::rolleyes:

Cela m'a fait plaisir de participer à ce fil, d'avoir appris de nouvelles choses et de votre sympathie... et surtout un grand merci à Patrick qui est EXCEL-ENT

En conclusion Ce Mémo clique est devenu Mémorable... :p:p:p Hi Hi Hi... c'était le CLAP de fin :):).

Laurent
 

patricktoulon

XLDnaute Barbatruc
re
je cède a la tentation ;) :p :p :p :cool:

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static old As String
    If old = "" Then
        old = Target.Address(0, 0)
        Cells(3, 2).Resize(, 24).Copy    'on copy la ligne 3
        With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With    'on paste le format

    Else
        With Range(old): .ClearFormats: .RowHeight = 15: End With    ' on  clearformats le range (la valeur de la custompropertie)
        old = Target.Address(0, 0)    ' on change l'adress dans la customproperties
        Cells(3, 2).Resize(, 24).Copy    'on copy la ligne 3
        With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With    'on paste le format
    End If
    Application.CutCopyMode = False    ' on arrete le copypaste

End Sub

bon d'accords je sort :oops:
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote