Fixer une image

[achraf26]

Bonjour,
je voudrais mettre une image coté gauche de la feuille quelle reste fixé au niveau de vision, elle sera pas lié aux cellule.
Ex : on va a la liegne 100 elle sera toujours là 🙂
j'éspere que vous m'avez compris
Merci

 

[DoubleZero]

Re : Fixer une image

Bonjour, achraf26, le Forum,

Je ne sais pas s'il est possible d'obtenir le résultat souhaité sans recourir à un UserForm.

A bientôt 🙂

P. S. : Bonjour, PMO2 🙂🙂

 

[PMO2]

Re : Fixer une image

Bonjour et bonjour DoubleZero,

C'est possible mais c'est plutôt compliqué.
Il faut fabriquer, par le biais des APIs Windows, des événements ScrollBar qui n'existent pas dans Excel pour pouvoir intercepter le VisibleRange de la fenêtre.

Je peux fabriquer un exemple si vous n'êtes pas rebuté.
Merci de me le dire.

 

[achraf26]

Re : Fixer une image

Merci 00,
lje voulais que image sert à aller à une autre feuille,et que je peux la voir toujours à sa place coté gauche, avec userForm ce nest pas une bonne idée, ce que je voulais faire c'est comme un menu, Bref ce n'est pas possible je crois 🙂

 

[achraf26]

Re : Fixer une image

un petit exemple avec une seule image ou deux suffit pour moi pour comprendre
🙂 Merci

 

[PMO2]

Re : Fixer une image

un petit exemple avec une seule image ou deux suffit pour moi pour comprendre

OK.

Faites l'essai sur une copie de votre classeur. A la moindre erreur sur les APIs, Excel plante.
1) Créez une feuille nommé "test"
2) Créez une image et nommez la "Image_pmo"
3) Copiez le code suivant dans la fenêtre de code de la feuille test

Private Sub Worksheet_Activate()
Set MaFeuille = ActiveSheet
Set MonImage = MaFeuille.Shapes("Image_pmo")
Call RunTimer(Delai:=100)
End Sub

Private Sub Worksheet_Deactivate()
Set MaFeuille = Nothing
Set MonImage = Nothing
Call OffTimer
End Sub

3) Copiez le code suivant dans la fenêtre de code de ThisWorkbook

Private Sub Workbook_Activate()
If ActiveSheet.Name = NOM_FEUILLE Then
  Set MaFeuille = ActiveSheet
  Set MonImage = MaFeuille.Shapes("Image_pmo")
  Call RunTimer(Delai:=100)
End If
End Sub

Private Sub Workbook_Deactivate()
Set MaFeuille = Nothing
Set MonImage = Nothing
Call OffTimer
End Sub

4) Copiez le code suivant dans un module Standard

Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd&, ByVal nIDEvent&)

'#############################################################
Public Const NOM_FEUILLE As String = "test" '### à adapter ###
'#############################################################

Public MonImage As Shape
Public MaFeuille As Worksheet
Public OnTimer&

Dim OldHscroll As Long
Dim OldVscroll As Long

Private Sub VisibleRangeWinProc()
Dim WD As Window
If ActiveSheet Is MaFeuille Then
  If Not MonImage Is Nothing Then
    Set WD = ActiveWindow
    If WD.ScrollColumn <> OldHscroll Then
      MonImage.Left = WD.VisibleRange.Cells(1, 1).Left
      OldHscroll = WD.ScrollColumn
    End If
    If WD.ScrollRow <> OldVscroll Then
      MonImage.Top = WD.VisibleRange.Cells(1, 1).Top
      OldVscroll = WD.ScrollRow
    End If
  End If
End If
End Sub

Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf VisibleRangeWinProc)
End Sub

Sub OffTimer(Optional dummy As Byte)
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub

 

[DoubleZero]

Re : Fixer une image

Re-bonjour,

PM😀2,

J'applaudis de mes quatre sabots : le fruit de votre travail est superbe.

A bientôt 🙂

 

[PMO2]

Re : Fixer une image

J'applaudis de mes quatre sabots : le fruit de votre travail est superbe.

Merci l'Ami.

 

[achraf26]

Re : Fixer une image

Super bon boulot, Subject résolu 🙂

 

[job75]

Re : Fixer une image

Bonjour achraf26, DoubleZero, PMO2,

Pour le fun, dans ThisWorkbook :

Dim marche As Boolean 'mémorise la variable

Private Sub Workbook_Activate()
marche = True
Application.OnTime 1, "ThisWorkbook.CadrerImage"
End Sub

Private Sub Workbook_Deactivate()
marche = False
End Sub

Sub CadrerImage()
While marche
  On Error Resume Next 'si la Shape n'existe pas
  With Feuil1.Shapes(1)
    .Top = ActiveWindow.VisibleRange(2, 2).Top
    .Left = ActiveWindow.VisibleRange(2, 2).Left
  End With
  DoEvents
Wend
End Sub

Fichier joint.

A+

 

[job75]

Re : Fixer une image

Re,

Vous remarquerez qu'avec la macro qui tourne il est impossible de modifier le code VBA.

Pour y parvenir il suffit d'ouvrir un autre document (touches Ctrl+N par exemple).

Pour avoir marche = False.

A+

 

[tototiti2008]

Re : Fixer une image

Bonjour à tous 🙂,

Une solution sans code VBA 😀
Bon, un peu faiblard mais comme personne ne l'avait proposé

 

[job75]

Re : Fixer une image

Salut Marc,

Tu as raison car il n'est pas sûr que notre ami sache ce qu'est un volet.

A+

 

[DoubleZero]

Re : Fixer une image

Bonjour à toutes et à tous,

j😀b75,

J'applaudis, itou, de mes quatre sabots : c'est magique.

tot😀titi,

J'aurais pu et dû 😱 y penser...

A bientôt 🙂