XL 2016 Figer la position de la fenêtre de commentaire dans une zone de la feuille de calcul visible.

[babast_s]

Bonjour à tous,

Je cherche à délimiter une zone sur ma feuille de calcul pour afficher les images que j'intègre dans les commentaires des diverses cellules.
Le souci c'est lors de l'intégration de l'image, la dimension de la fenêtre de commentaire reste, mais pas sa position sur la feuille de calcul.
De ce fait les trois quart de l'affichage des image se font or de l’écran, il faut donc se déplacer sur la feuille de calcule alors que je n'ai pas besoin de le faire.
Il existe peut être une autre solution, mais or de ma connaissance pour le moment.

Merci pour votre aide, bonne journée, babast.

 

[patricktoulon]

pour le 4° je repete
comme je te l'ai dit quand on modifie par vba la position des commentaires
A CHAQUE FOIS LE COMMENTAIRE VA D ABORDS SE POSER A SON LEFT/TOP PAR DEFAUT

 

[job75]

@job75, Merci beaucoup, l'idée de tout bloque, me plait énormément, car je partage ce ficher avec beaucoup de personnes, mets je viens de faire l'essais sur le ficher, mais hélas la quarantaines de feuilles dans le fichier dois l’empêcher de fonctionner ou alors j'ai raté quelque chose, du coup il faut que je puisse faire individuellement sur chaque feuille car elles ne sont pas identique, je suis preneur de tes idées. Encore Merci.

Si toutes les feuilles ont la même structure on peut modifier la Workbook_Open :

Private Sub Workbook_Open()
Dim w As Worksheet
For Each w in Worksheets
    w.ScrollArea = "A1:T39" 'interdit le défilement
Next
End Sub

Sinon il faut ajouter un test pour ne traiter que les feuilles désirées.

 

[patricktoulon]

juste une parentheze
un autre exemple de l'utilité de cette astuce
en effet parti de la, puisque l'on a une surveillance constante
on peu même créer l'events qui n'existe pas d'un object
par exemple un qui manque

Private Sub Application_Resize(ByVal ALeft As Long, ByVal Atop As Long, ByVal Awidth As Long, ByVal Aheight As Long)
End Sub

ben que cela te tienne
ici on interdit la maximisation de la fenetre dans le (heu.. hum hum 😵😀) evenement "application_resize"
tiens essai de la maximiser ??😉

Option Explicit
Public WithEvents Cmbrs As CommandBars     'creation de l'object commandbars events
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set Cmbrs = Nothing
End Sub

Private Sub Workbook_Open()
    Set Cmbrs = Application.CommandBars
    Cmbrs_OnUpdate
End Sub
'evenement commandbars
Private Sub Cmbrs_OnUpdate()
   DoEvents
   With Application
        .CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
        Application_Resize .left, .top, .width, .height
    End With
End Sub


' un vrai faux evenement :):):)
Private Sub Application_Resize(ByVal ALeft As Long, ByVal Atop As Long, ByVal Awidth As Long, ByVal Aheight As Long)
    [b1] = ALeft
    [B2] = Atop
    [B3] = Awidth
    [B4] = Aheight

With Application
If Atop < 0 Then .WindowState = xlNormal: .width = 500: .height = 400
End With
End Sub

rigolo non ?

 

[Dudu2]

Ah oui, désolé, j'avais zappé la 1ère réponse. En effet, c'est comme ça pour les commentaires, et de toutes façons ça n'a pas d'importance.

Donc on peut utiliser ce système pour avoir un traitement cyclique. Super intéressant.
En l'occurrence, j'ai tracé (en tableau mis en cellule à la fin pour limiter l'impact traitement) il se répète 3 à 4 fois par seconde ce qui est très peu pour une boucle infernale avec un traitement de .Top sur 3 commentaires. Il doit forcément y avoir une temporisation quelque part en interne. L'essentiel c'est qu'il ne mette pas la CPU à genou.
En tous cas c'est mieux qu'un OnTime dont la résolution minimale est 1 seconde.

Sub ReplaceComment()
    Static i As Integer
    Static t(1 To 100, 1 To 1) As Variant
   
    i = i + 1
    If i = 1 Then ActiveSheet.Range("A1:A100").ClearContents
    If i <= UBound(t, 1) Then
        t(i, 1) = Now
    ElseIf i = UBound(t, 1) + 1 Then
        ActiveSheet.Range("A1:A100").Value = t
        ActiveSheet.Range("A1:A100").NumberFormat = "h:mm:ss"
    End If
   
    Dim Com As Comment
    For Each Com In ActiveSheet.Comments
        Com.Shape.Top = ActiveWindow.VisibleRange.Top + 15
    Next
End Sub

 

[patricktoulon]

En tous cas c'est mieux qu'un OnTime dont la résolution minimale est 1 seconde.

tu as tout compris
ainsi que tout timer dans un do loop (tres lourd et gourmand en ressource
seul l'api settimer et killtimer pour tuer le settimer se comporte comme cette astuce pour la simple et bonne raison qu'il extériorise l’exécution du code par le addressof
je vous fait une démo si vous voulez 😉

 

[babast_s]

Si toutes les feuilles ont la même structure on peut modifier la Workbook_Open :

Private Sub Workbook_Open()
Dim w As Worksheet
For Each w in Worksheets
    w.ScrollArea = "A1:T39" 'interdit le défilement
Next
End Sub

Sinon il faut ajouter un test pour ne traiter que les feuilles désirées.

J'ai intégré le code (en fichier joint) fonctionne sur tous les onglets du fichier, mais hélas elles sont toutes différentes du coup j'ai tenté de modifier le code :
w.ScrollArea = "A1:T39" 'interdit le défilement
en
w.ScrollArea = Sheets("345801K4").Rows("A1:T100") 'interdit le défilement
Mais sans succès.
Merci encore pour votre aide.

 

[patricktoulon]

re
si elle sont toute différentes,tu veux bien essayer ceci plutot ? 😉
For Each w in Worksheets
w.ScrollArea = "A1:T"& w.usedrange.rows.count 'interdit le défilement
Next

 

[patricktoulon]

re
mille excuses
je corrige ma méprise
le scroll s’arrête a la dernière cellule pleine
For Each w In Worksheets
With w.UsedRange: w.ScrollArea = "A1:T" & .Cells(.Cells.Count).Row: End With 'interdit le défilement
Next

 

[job75]

Il est plus sûr de bloquer sur le VisibleRange :

Private Sub Workbook_Open()
Dim F As Object, w As Worksheet
Set F = ActiveSheet
Application.ScreenUpdating = False
For Each w In Worksheets
    w.Visible = xlSheetVisible 'si la feuille est masquée
    Application.Goto w.Cells(1), True 'cadrage
    w.ScrollArea = ActiveWindow.VisibleRange.Address 'interdit le défilement
Next
F.Activate
End Sub

 

[patricktoulon]

re
@job75 oui si les commentaires en question sont bien dans le visiblerange "A1:XY"
comme il scroll jusqu'a 100 j'en doute
je pense qu'il veut jusque eviter de descendre trop bas avec le scroll en tout cas plus bas que le end(xlup) du usedrange
et puis d'un pc a l'autre le visiblerange.rows.count peut varier en fonction de la résolution
c'est le cas chez moi avec 1:17 sur le pc portable 15 pouce et 1: 31 sur le pc fixe grand ecran en dpi 120 😉
de plus de cette manière tu active tout les sheets avant de revenir au sheet initial a l'open c'est bof 😉

 

[job75]

Avec le code de patricktoulon ça donne ceci :

Private Sub Workbook_Open()
Dim w As Worksheet
Set feuille = ActiveSheet
Application.ScreenUpdating = False
For Each w In Worksheets
    w.Visible = xlSheetVisible 'si la feuille est masquée
    Application.Goto w.Cells(1), True 'cadrage
    w.ScrollArea = ActiveWindow.VisibleRange.Address 'interdit le défilement
Next
feuille.Activate
Set Cmbrs = Application.CommandBars
Cmbrs_OnUpdate
End Sub

 

[Dudu2]

Je reviens sur l'affichage des commentaires qui est assez compliqué.
Il semble que la propriété Comment.Shape.Top ne soit réellement utilisée / appliquée que lorsque le commentaire est affiché. Probablement parce que .Top est un propriété de la Shape et pas de Comment.

Ainsi en ne valorisant qu'une seule fois pour une feuille donnée les Comment.Shape.Top = 15 (par exemple) les commentaires NE s'affichent PAS en 15 bien que les Comment.Shape.Top soient effectivement à 15.

Ça marche dans le code de Patrick parce que dans la fonction ReplaceComment, la valorisation des Comment.Shape.Top est faite à chaque évènement (toutes les 1/3 ou 1/4 de seconde) et lors d'un affichage de commentaire par survol souris de la cellule, un évènement intervient rapidement pour en corriger le Comment.Shape.Top qui est alors pris en compte précisément parce que le commentaire est affiché. D'où cette affichage double, une 1ère fois en position initiale suivie d'une 2ème fois en position corrigée.

 

[patricktoulon]

re
oui Dudu2 c'est possible c'est cohérent en tout cas avec l'observation du phénomene
peut être un displayscreenupdating aussi diminuerait cet artefact je ne sais pas (a tester)
bon les gars je me suis bien amusé ,je parts sur chantier a toutes a l'heure
a + 😉

 

[babast_s]

Avec le code de patricktoulon ça donne ceci :

Private Sub Workbook_Open()
Dim w As Worksheet
Set feuille = ActiveSheet
Application.ScreenUpdating = False
For Each w In Worksheets
    w.Visible = xlSheetVisible 'si la feuille est masquée
    Application.Goto w.Cells(1), True 'cadrage
    w.ScrollArea = ActiveWindow.VisibleRange.Address 'interdit le défilement
Next
feuille.Activate
Set Cmbrs = Application.CommandBars
Cmbrs_OnUpdate
End Sub

Merci, pour cette mise à jour, elle fonctionne dans l'intégration du fichier.
Mais le blocage doit se réaliser sur toutes les feuilles de A à T, jusque là pas de souci, mais varie de 45 à environ 800 lignes en fonction du tableau.
Je vous sollicite une fois de plus, pour intégrer vos codes magiques qui permets de faire évoluer mon fichier.

Encore Merci à Tous.

 

[job75]

Je ne vois pas l'intérêt de bloquer le Scroll si on lui permet d'aller sur 800 lignes !!!

Patrick a donné un code pour fonctionner sur tout le UsedRange, je n'en vois pas l'intérêt non plus.