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

gsx-air · 6 Juillet 2021

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 · 6 Juillet 2021

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

gsx-air · 7 Juillet 2021

herve62 à dit:
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 · 7 Juillet 2021

Bonsoir.

VB:

If TypeOf Selection Is Excel.Picture Then

gsx-air · 7 Juillet 2021

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 · 7 Juillet 2021

voici le fichier

gsx-air · 12 Juillet 2021

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

Dranreb · 12 Juillet 2021

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 · 12 Juillet 2021

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 · 12 Juillet 2021

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 · 12 Juillet 2021

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 · 12 Juillet 2021

Dranreb à dit:
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 · 12 Juillet 2021

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

gsx-air · 12 Juillet 2021

Dranreb à dit:
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 · 12 Juillet 2021

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

:

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

gsx-air

XLDnaute Nouveau

herve62

XLDnaute Barbatruc

gsx-air

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

gsx-air

XLDnaute Nouveau

gsx-air

XLDnaute Nouveau

Pièces jointes

gsx-air

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

gsx-air

XLDnaute Nouveau

gsx-air

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

gsx-air

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

gsx-air

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Discussions similaires