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

gsx-air

XLDnaute Nouveau
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
 
Dernière édition:

gsx-air

XLDnaute Nouveau
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
 

Dranreb

XLDnaute Barbatruc
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.
Code:
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

XLDnaute Nouveau
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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)
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
La version qui se relance après 3 secondes si on répond OK :
VB:
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
:
 

Discussions similaires

Réponses
2
Affichages
148

Statistiques des forums

Discussions
314 450
Messages
2 109 724
Membres
110 552
dernier inscrit
jasson