XL 2016 vérifier si une image est sélectionnée

[gsx-air]

salut a tous
j'ai un fichier Excel dans lequel je glisse 4 a 5 images différentes ensuite je clique sur une image puis je lance une petite macro pour redimensionner et positionner chaque image
mais lorsque je lance ma macro si je n'ai pas sélectionner l'image auparavant la macro ne fonctionne pas (erreur)
je souhaiterais donc contrôler au début de ma macro qu'une image est sélectionnée pour pouvoir continuer la macro

je souhaiterais contrôler
si pas d'image sélectionnée
message box (vous devez sélectionner une image pour continuer la macro)
pouvoir sélectionner une image
contrôler a nouveau
si ok on continue la macro
si pas ok on sort de la macro

merci par avance

j'ai essayais avec la fonction erreur mais je n'arrive a ne contrôler que la première fois

 

[herve62]

Bonjour
Bizarre je n'arrive pas à lancer ta macro pour tester.......???

 

[gsx-air]

Bonjour
Bizarre je n'arrive pas à lancer ta macro pour tester.......???

Bonjour vous souhaitez que je mette mon fichier avec ma macro permettant le positionnent de l'image ?
Je peux la mettre demain
Bonne soirée

 

[Dranreb]

Bonsoir.

If TypeOf Selection Is Excel.Picture Then

 

[gsx-air]

salut a tous voici la ou j'en suis mais ça ne fonctionne pas
soyez indulgent je suis loin d'être un expert

Sub DEPLACimage1()

Dim largimage As Integer
Dim hautimage As Integer
Dim hautcolon As Integer
Dim placedisp As Integer
Dim nombimag As Integer
Dim positimag As Variant
Dim shp As Shape

On Error GoTo ShapeNotSelected
Set shp = ActiveSheet.Shapes(Selection.Name)
On Error GoTo errorHandler

positimag = Application.InputBox("Position 1,2,3...", "POSITION DE L'IMAGE", Type:=1)


nombimag = Range("G1").Value
hautcolon = Range("b6").Top - Range("b2").Top + Range("b6").Height
largimage = Range("b2").Width
hautimage = Selection.ShapeRange.Height
placedisp = hautcolon / nombimag
Selection.ShapeRange.Width = largimage

If hautimage > placedisp Then
Selection.ShapeRange.Height = placedisp
End If
Selection.ShapeRange.Left = Range("b2").Left + (Range("b2").Width - Selection.ShapeRange.Width) / 2
Selection.ShapeRange.Top = Range("b1").Height + ((hautcolon / nombimag) * positimag) - (hautcolon / (nombimag * 2)) - ((Selection.ShapeRange.Height) / 2)

errorHandler:
ShapeNotSelected:
MsgBox "veuillez selectionner une image"

End Sub

 

[gsx-air]

voici le fichier

 

[gsx-air]

bonjour
existe t'il une fonction similaire a "Application.InputBox("choisissez une cellule", Type:=8)" qui permette de sélectionner une image
merci

 

[Dranreb]

Bonjour.
À part ça, en employant un Excel.Picture au lieu d'un Shape, j'ai pu intégrer le test que je vous avais conseillé, et qui n'a pas eu l'air de vous intéresser, ce qui m'avait incité à ne pas poursuivre.

Option Explicit
Sub DéplacImage1()
   Dim Img As Excel.Picture, PosImg As Integer, NbImg As Integer, _
      Gauche As Double, Largeur As Double, Dessus As Double, Bas As Double
   If Not TypeOf Selection Is Excel.Picture Then
      MsgBox "Veuillez selectionner une image", vbCritical, "DéplacImage1"
      Exit Sub: End If
   Set Img = Selection
   PosImg = Application.InputBox("Position 1,2,3...", "POSITION DE L'IMAGE", Type:=1)
   NbImg = ActiveSheet.[G1].Value
   With ActiveSheet.[B2:B6]: Gauche = .Left: Largeur = .Width
      Dessus = .Top: Bas = Dessus + .Height: End With
   Img.Top = IntpoLin(PosImg, 0.5, Dessus, NbImg + 0.5, Bas) - Img.Height / 2
   Img.Left = Gauche + (Largeur - Img.Width) / 2
   End Sub
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function

 

[gsx-air]

bonsoir
merci pour votre réponse en effet cela fonctionne bien et j'apprécie la façon d'on vous avez réécris la macro je n'aurais pas su le faire (mais ca me permet d'apprendre un peu plus)
et je ne dirai pas que votre proposition ne n'intéressé pas c'est plutôt que je n'ai pas su l'exploiter j'ai un niveau en macro plutôt faible je recherche beaucoup de code sur le net que je compile j'adapte je test mais ça a ses limite

pour revenir a cette macro croyez vous qu'il soit possible dans le cas ou une image n'est pas sélectionnée après avoir affiché la message box de pouvoir sélectionner une image et que la macro continue
je ne sais pas si je suis très clair

début de la macro
si pas d'image sélectionnée
message box (vous devez sélectionner une image pour continuer la macro)
permettre la sélection d'une image sans sortir de la macro
contrôler a nouveau
si ok on continue la macro
si pas ok on sort de la macro

 

[gsx-air]

après relecture ne serait t il pas plus simple de lancer la macro et de demander a choisir l'image dans la macro

je suis parti sur la sélection de l'image en premier parce que j'ai commencer le code avec l'enregistreur de macro
ce serait certainement plus simple
qu'en pensez vous
merci

 

[Dranreb]

Ce n'est guère faisable de rendre la main à Excel sans sortir de la macro.
On peut éventuellement planifier une ré-exécution de la macro dans les 3 secondes qui suivent.
On peut aussi l'adapter pour qu'elle puisse être affectée aux images, de sorte qu'elle s'exécutera quand on cliquera sur l'une d'elle. Dans ce dernier cas il faut à nouveau utiliser un Shp As Shape et faire au début Set Shp = ActiveSheet.Shapes(Application.Caller)

 

[gsx-air]

On peut aussi l'adapter pour qu'elle puisse être affectée aux images, de sorte qu'elle s'exécutera quand on cliquera sur l'une d'elle.

dois je comprendre que l'on peut lancer la macro en cliquant sur une image, n'importe laquelle même si je viens de la glisser sur la feuille ?

 

[Dranreb]

Non, il faut lui affecter la macro par clic droit, Affecter une macro…

 

[gsx-air]

Non, il faut lui affecter la macro par clic droit, Affecter une macro…

ok
merci
je vais conserver le code que vous m'avez proposé
encore merci

 

[Dranreb]

La version qui se relance après 3 secondes si on répond OK :

Option Explicit
Sub DéplacImage1()
   Dim Img As Excel.Picture, PosImg As Integer, NbImg As Integer, _
      Gauche As Double, Largeur As Double, Dessus As Double, Bas As Double
   If Not TypeOf Selection Is Excel.Picture Then
      If MsgBox("Veuillez sélectionner une image", vbOKCancel, "DéplacImage1") _
         = vbOK Then Application.OnTime Now + TimeSerial(0, 0, 3), "DéplacImage1"
      Exit Sub: End If
   Set Img = Selection
   PosImg = Application.InputBox("Position 1,2,3...", "POSITION DE L'IMAGE", Type:=1)
   NbImg = ActiveSheet.[G1].Value
   With ActiveSheet.[B2:B6]: Gauche = .Left: Largeur = .Width
      Dessus = .Top: Bas = Dessus + .Height: End With
   Img.Top = IntpoLin(PosImg, 0.5, Dessus, NbImg + 0.5, Bas) - Img.Height / 2
   Img.Left = Gauche + (Largeur - Img.Width) / 2
   End Sub
Function IntpoLin(ByVal X As Double, ByVal X1 As Double, ByVal Y1 As Double, _
                                     ByVal X2 As Double, ByVal Y2 As Double) As Double
   IntpoLin = Y1 + (Y2 - Y1) * (X - X1) / (X2 - X1)
   End Function

: