Voilà, je vous présente 2 codes qui fonctionne bien et dont le principe est le même : insérer une image GIF dans une cellule à partir d'un bouton (Gazole) placé sur ma feuille de calcul.
Le premier :
Code:
Private Sub Gazole_Click()
Dim MyCell As Range
Dim MyPicture As Picture
Dim image$
image = "C:\Documents and Settings\Moi\Mes documents\Mes images\Pompe.gif" 'ou le chemin désiré
Set MyCell = ActiveCell
MyCell.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MyCell.Height
.Width = MyCell.Width
End With
MyCell.Select
End Sub
et le deuxième :
Code:
Private Sub Gazole_Click()
If Not Intersect(Selection, Range("C3:IJ33")) Is Nothing Then
With Sheets("Feuil1")
.Shapes("Image 14").Copy
End With
ActiveSheet.Paste
Selection.ShapeRange.Left = ActiveCell.Left + 1
Selection.ShapeRange.Top = ActiveCell.Top + 2
Range("A1").Select
Exit Sub
End If
MsgBox "Mauvaise Sélection !"
Range("A1").Select
End Sub
Le premier code va me chercher l'image (Pompe.gif) sur mon disque dur. Dans le deuxième code, mon image est stockée dans la "Feuil1" de mon classeur. ("Image 14") = Pompe.gif
Pour le stockage de l'image, je préfere retenir la première solution, d'autant que ce code me restitue l'image à la taille de la cellule de destination contrairement au deuxième code.
Par contre, j'aimerais adapter le principe du deuxième code qui limite l'insertion de l'image à une plage donnée (C3:IJ33) avec apparition d'une Msgbox lors d'une mauvaise sélection.
Qui pourrait rectifier mon premier code en y intégrant le principe décrit ci-dessus (If Not Intersect(Selection, Range("C3:IJ33")) etc...), je n'y arrive pas !!!!
Private Sub Gazole_Click()
If Not Intersect(Selection, Range("C3:IJ33")) Is Nothing Then
Dim MyCell As Range
Dim MyPicture As Picture
Dim image$
image = "C:\Documents and Settings\Moi\Mes documents\Mes images\Pompe.gif" 'ou le chemin désiré
Set MyCell = ActiveCell
MyCell.Select
Set MyPicture = ActiveSheet.Pictures.Insert(image)
With MyPicture.ShapeRange
.LockAspectRatio = msoFalse
.Height = MyCell.Height
.Width = MyCell.Width
End With
MyCell.Select
exit sub
End if
MsgBox "Mauvaise Sélection !"
Range("A1").Select
End Sub
Par contre, la macro "Effacer" corrigée par pierrejean ne fonctionne que partiellement (en passant, j'ai inversé l'ordre End if, Exit sub).
Je m'explique :
Comme je l'énonçais plus haut, j'ai une colonne de dates de B3 à B33, aussi lorsque je sélectionne la cellule B3 et exécute la macro "Effacer", le message "Mauvaise sélection" s'affiche bien.
Par contre si j'inclus maladroitement à B3 les cellules C3 à D3, la macro "Effacer" ne tient plus compte de la cellule B3 et m'efface la totalité de la plage B33.
Comment y remédier pour que cela m'affiche aussi "Mauvaise sélection ?
comprends pas trop chez moi le code ci dessous fonctionne si sélection B3:H3 :
Code:
If Not Intersect(Selection, Range("C3:IJ33")) Is Nothing And Selection.Count = 1 Then
Selection.ClearContents
Selection.Interior.ColorIndex = xlNone
Else
MsgBox "Mauvaise Sélection !", , Range("C2").Value
End If
En fait çà marche, mais ce qui ne fonctionne plus c'est lorsque je sélectionne plusieurs cellules dans la plage C3:IJ33, cela ne s'efface plus, la boîte de message "Mauvaise sélection apparait !!!
Si je sélectionne 1 seule cellule dans C3:IJ33, ça s'efface.
j'avais pas tout compris... Dans ce cas essaye avec une boucle :
Code:
Dim c As Range
For Each c In Selection
If Not Intersect(c, Range("C3:IJ33")) Is Nothing Then
c.ClearContents
c.Interior.ColorIndex = xlNone
Else
MsgBox "Mauvaise Sélection, cellule : " & c.Address(0, 0), , Range("C2").Value
End If
Next c