Fixer une image ?

[Fredman]

Salut

Savez vous comment fixer une image dans Excel (insertion/image) ?

Merci

 

[PMO2]

Re : Fixer une image ?

@PMO2 oui j'ai essayé de l'affecter a une macro ça fonctionne niquel mais j'ai près de 10 photos donc cela va faire 10 macros dans le vide..

NON, une seule macro suffit.
Faites un clic droit sur chacune de vos images puis Affecter une macro/sélectionner toujours la même macro BidonClic.

S'il y a une grande quantité d'images, on peut faire un programme pour l'affectation de la macro.

 

[Fredman]

Re : Fixer une image ?

Ah ok merci PMO2 c'est résolu

 

[Fredman]

Re : Fixer une image ?

NON, une seule macro suffit.
Faites un clic droit sur chacune de vos images puis Affecter une macro/sélectionner toujours la même macro BidonClic.

J'aimerais juste savoir si après avoir affecter un macro a mes images d'avoir ce message ci-dessous lorsque je clic dessus?
Regarde la pièce jointe 936689

 

[mapomme]

Re : Fixer une image ?

Bonjour Fredman, à tous,

Une autre piste:

• pour Libérer les formes d'une feuille et pouvoir les déplacer, taper Ctrl+Maj+L
• pour Fixer les formes d'une feuille, taper Ctrl+Maj+F.

En fait on peut toujours déplacer les formes (V1a directement et clique-droit pour la v1a - clique-droit pour la v1b) , mais dès la sélection d'une cellule, les formes reprennent leur position (déterminée lors du dernier Ctrl+Maj+F )

Le code principal est dans Module1 et pour chaque feuille concernée, on met le code suivant dans le module de code de la feuille.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  elastic
End Sub

et dans Module1:

 Sub Fixer()
' Raccourci Ctrl + Maj + F
Dim shp As Shape

  With ActiveSheet
    On Error GoTo Suite
    For Each shp In .Shapes
      shp.Title = shp.Left & ";" & shp.Top
Suite:
      Next shp
    On Error GoTo 0
  End With
End Sub

 Sub Liberer()
' Raccourci Ctrl + Maj + L
Dim shp As Shape

  With ActiveSheet
    On Error GoTo Suite
    For Each shp In .Shapes
      shp.Title = ""
Suite:
    Next shp
    On Error GoTo 0
  End With
End Sub

Sub elastic()
Dim shp As Shape, LeftTop
  
  With ActiveSheet
    On Error GoTo Suite
    For Each shp In .Shapes
      LeftTop = Split(shp.Title, ";")
      If UBound(LeftTop) = 1 Then
        If IsNumeric(LeftTop(0)) And IsNumeric(LeftTop(1)) Then
          shp.Left = Split(shp.Title, ";")(0)
          shp.Top = Split(shp.Title, ";")(1)
        End If
      End If
Suite:
    Next shp
  End With
End Sub

edit : v1a -> idem v1 mais fichier moins volumineux.
edit : v1b -> idem v1a plus la méthode PMO (que je salue 🙂). Affectation de la macro NOP() aux formes.