Microsoft 365 mémo_clic fonctionnement

[Usine à gaz]

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,

 

[laurent950]

Bonsoir Patrick,

C'est vraiment très agréable d'avoir des réponses à mes questions et de prendre le temps de
me répondre.

Alors pour les Constantes j'ai à présent compris, justes des valeurs fixes c'est compris merci

Pour cela tu as certainement raisons
cela fonctionne un peux comme cela
dim wks as Workbook
set wks = Workbooks(ActiveWorkbook.Name)
dim sh as Worksheets
set sh = wks.Worksheets(ActiveSheet.name)

donc :
CustomProperty (Le classeur)
CustomProperties (La feuille du classeur)

Par contre je ne sais pas faire fonctionner CustomProperty est pas l'idée aussi de l'utiliser selon un cas établie !

j'apprend aussi que j'utilise le 'early binding (C'est assez bien avec les propositions suite aux . Points (les prpositions)

Pour cela 'latebinding tu m'avais expliquer que c'était mieux pour le donner un utilisateur (pas besoin d'ajouter a la boite a outils VBA les
Bibliothéques si ma mémoire est bonne)

C'est vrais pour : 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
Donc j'ai ajouter "Init" pour les premieres valeurs fausses de mon premier fichier (J'avais pas compris au tous début votre code)
Pourquoi : A1
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:="A1"
Comme impossible de faire un teste si la value est vide Cause mémoire insufisante j'ai noté "Init"

La vrais questions :
Le dernier fichier poster de Mon poste #43 est t'il bien construit !

Je vous remercie Patrick c'est vraiment très gentil est agréable de me répondre et j'apprend très très vite grace à vos explictaions

Laurent

 

[laurent950]

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

regarde pourquoi!!!

Merci Patrick Magnifique votre poste #45 avec la boucle For Each (Balayer la collections c'est super)

J'ai comrpris.
J'ai utilisé cela au lieu de la boucle for Each
' Efface la variable CustomProperties
For i = 1 To Me.CustomProperties.Count
Me.CustomProperties.Item(1).Delete
Next i
Vs = je préféres For Each (très bien)
For Each customprp In Me.CustomProperties
customprp.Delete
Next

Vraiment très bien cette idée de CustomProperties (très bien cette méthodes)

Merci Patrick

 

[patricktoulon]

re

moi j'ai mis "A1" pour que des que le else passe c'est la ligne 1 qui sera clearformat

comme il est impossible d'ajouter une custompropertie vide
tu te doute bien que tester si elle est "<>"" est aussi impossible

dans mon exemple je fait
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Feuil1" Then
' Depart
ActiveSheet.Unprotect Password:=""
Application.ScreenUpdating = False
If ActiveSheet.CustomProperties.Count = 0 Then
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:="A1"
Else
With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With
ActiveSheet.CustomProperties(1).Value = Target.Address(0, 0)
Cells(3, 2).Resize(, 24).Copy
With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With
End If
Application.CutCopyMode = False


ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Application.ScreenUpdating = True
End If
End Sub

si je met "init comme toi quand la ligne verte sera déclenchée çà va faire quoi d’après toi ?????? la range ("init") n'existe pas BUG!!!!

si ligne 1 utilisée et non concernée par le clear format mettre a la place .value=cells(rows.count,columns.count).address(0,0)
ca te mettra la "A104576"( la derniere ) c'est rare d'utiliser tout la grille

voili voilou

 

[patricktoulon]

re
je vais peut etre un peu vite
For i = 1 To Me.CustomProperties.Count
Me.CustomProperties.Item(1).Delete
Next i

tu te rend bien compte que la tu tente de supprimer la une autant de fois qu il y a de customprop

 

[laurent950]

For i = 1 To Me.CustomProperties.Count
Me.CustomProperties.Item(1).Delete
Next i

Justement j'ai créer 3 Item mais ca plante quand je met cela i
Me.CustomProperties.Item(i).Delete ??? Impossible, j'ai testé avant de poster

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 testsupprOK() 'pour supprimer toute les prop custom avant de relancer la sub test
For Each customprp In ActiveSheet.CustomProperties
    customprp.Delete
Next

End Sub

Sub testsupprBisOK() 'pour supprimer toute les prop custom avant de relancer la sub test
For i = 1 To ActiveSheet.CustomProperties.Count
    ActiveSheet.CustomProperties.Item(1).Delete
Next i
End Sub

Sub testsupprTerErreur1() 'pour supprimer toute les prop custom avant de relancer la sub test
' Item(i)
For i = 1 To ActiveSheet.CustomProperties.Count
    ActiveSheet.CustomProperties.Item(i).Delete
Next i
End Sub

Sub testsupprTerErreur2() 'pour supprimer toute les prop custom avant de relancer la sub test
' Items(i)
For i = 1 To ActiveSheet.CustomProperties.Count
    ActiveSheet.CustomProperties.Items(i).Delete
Next i
End Sub

Sub testsupprTerErreur3() 'pour supprimer toute les prop custom avant de relancer la sub test
' CustomProperties(i)
For i = 1 To ActiveSheet.CustomProperties.Count
    ActiveSheet.CustomProperties(i).Delete
Next i
End Sub

Sub testsupprSISIOK()    'pour supprimer toute les prop custom avant de relancer la sub test
' Résolu et trouver par PATRICKTOULON merci patrick
' il faut boucler a reculon
' soit la correction des VBA
' testsupprTerErreur1 & testsupprTerErreur2 & testsupprTerErreur3
' avec cette dernier c'est OK pour le VBA testsupprSISIOK
    With ActiveSheet.CustomProperties
        If .Count > 0 Then
            For i = .Count To 1
                .Item(i).Delete
            Next i
        End If
    End With
MsgBox ActiveSheet.CustomProperties.Count
End Sub

 

[patricktoulon]

re
Justement j'ai créer 3 Item mais ca plante quand je met cela i
?????????
bon pour la forme j'ai revue ma version que j'ai commenté ligne par ligne
en effet ma version n'avait pas l'effet copy paste formats au premier click apres ouverture du classeur donc coquille corrigée

tout!! dans le module thisworkbook

'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 aucune  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

pour le coup la c'est perfect !!!

 

[patricktoulon]

re
heu au fait

Me.CustomProperties.Item(1).Delete 'item kézakoca????? ca serait pas plutot "itemS"
et puis pourquoi se casser la tete
Me.CustomProperties(i).Delete
t'a un peu de soucis avec les collection toi
un classeur c'est workbook
des classeurS c'est workbooks
un sheets c'est worksheet
des classeurS c'est workbooks
un item des itemS

for each truc in object.itemS

for each wbk in workbookS

for eac sh in worksheetS

on atteint un element par son nom
soit par l'object lui meme avec son nom
exemple
set mysheet=sheets(1)
set monclasseur = thisworkbook

soit par la collection (S)
set my sheet=worksheetS("toto")
set monclasseur=workbookS("trucmachin.xlsm")

 

[laurent950]

ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:="A1"

Ici je suis entièrement d'accord avec vous, je n'avais pas vu cette astuce que j'ai contourné différemment, mais très bien je viens de comprendre. Merci c'est super

 

[patricktoulon]

re
reprends le post #51 le code est abouti

 

[laurent950]

re
heu au fait

Me.CustomProperties.Item(1).Delete 'item kézakoca????? ca serait pas plutot "itemS"
et puis pourquoi se casser la tete
Me.CustomProperties(i).Delete

Ca ne fonctionne pas Patrick, j'ai poster le fichier test en Poste #50 et remis a jour, je suis aussi surpris que vous sur ce sujet de boucle avec la variable i

 

[patricktoulon]

re
d'accord je viens de comprendre ton erreur

Sub testsupprTerErreur1() 'pour supprimer toute les prop custom avant de relancer la sub test
' Item(i)
For i = 1 To ActiveSheet.CustomProperties.Count
    ActiveSheet.CustomProperties.Item(i).Delete
Next i
End Sub

t'es tu seulement posé la question
et si il n' y a pas de custom properties??? que represente ActiveSheet.CustomProperties.Items(i)????

ben..... un BUG!!!!!

LOL

LA boucle for each truc in machins veut dire pour tout les trucs dans la collection machins
comme il n'y en a pas!!!! ben... la boucle tourne pas; donc pas d'erreur déclenchée
si je devais boucler par itération
je ferais

Sub testsupprTerErreur1() 'pour supprimer toute les prop custom avant de relancer la sub test

' Item(i)

if activesheet.customproperties.count>0 then

For i = 1 To ActiveSheet.CustomProperties.Count

    ActiveSheet.CustomProperties.Item(i).Delete

Next i

end if

End Sub

re lol

 

[laurent950]

t'es tu seulement posé la question
et si il n' y a pas de custom properties??? que represente ActiveSheet.CustomProperties.Items(i)????

ben..... un BUG!!!!!

LOL

selon l'exemple du fichier ci je remplis les 3 premiers Custom properties
j'en delete bien 2 mais le troisième impossible
Pourtant il y en a bien 3 de remplis toujours étonnant !
Fichier poste #50

' alors effectivement ne fonctionne absolument pas avec Items(i)????

ce que vous proposer aussi au poste # 56
' mais bien avec Item (i) soit 2 effacé sur 3 cf ci dessous
donc : Pour test fichier Poste #50
Effacer :
ActiveSheet.CustomProperties.Add Name:="toto", Value:="truc"
ActiveSheet.CustomProperties.Add Name:="titi", Value:="machin"
ici la boucle plante et Non effacer !! :
ActiveSheet.CustomProperties.Add Name:="rififi", Value:="bidule"

Les trois sont bien remplis

Merci

Laurent

 

[laurent950]

Un petit mot à patricktoulon et sa gentillesse de m'avoir aidé et appris via ce poste, et de m'avoir permis de progresser et d'apprendre des choses qui ne sont pas forcément très intuitives et d'avoir pu profiter de son expérience. ce Forum est vraiment extra et très riche
Un Grand Grand Merci à Patrick
Laurent

 

[patricktoulon]

ok je viens de comprendre l'erreur que je fait j'ai honte non de dieu

imaginons que tu au 5 customprop
et que tu suprime la i(i=1)
il t'en reste combien?????????
4
sauf que la boucle (i) va aller jusqu'a 5 c'est ballo hein car la 5 est devenu la (je te le donne dans le mille) LA 4!!!!(la 5 n'existe plus !!!!

que faut t il faire ????
ben comme pour toutes les collection excel on boucle a reculons

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 testsupprSISIOK()    'pour supprimer toute les prop custom avant de relancer la sub test
    With ActiveSheet.CustomProperties
        If .Count > 0 Then
            For i = .Count To 1
                .Item(i).Delete
            Next i
        End If
    End With
MsgBox ActiveSheet.CustomProperties.Count
End Sub

J'AI honte tellement c'est évident

la fatigue j'ai eu une grosse journée

 

[laurent950]

ben comme pour toutes les collection excel on boucle a reculons

Ha ha ha non surtout pas avoir honte... qui sur ce forum à la connaissance de cela, qu'il faut boucler a reculons pour une collection certainement pas moi et si ont fait un petit sondage peux être peux de personnes le savent !!!

C'est noté précieusement dans un coin de ma tête :
Bloucle For Each = On boucle a Reculons (Cela est vraiment extra de savoir cela est cela me sera bien utile un jour)

Un Grand merci vous êtes vraiment très très très fort

Modifier poste #50
Nouvelle procédure a reculons + Fichiers Excel mise a jours

Laurent