Vba : Limiter l'insertion à une plage donnée

[cibleo]

Bonjour le forum,

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 :

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 :

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 !!!!

Merci de votre aide Cibleo

 

[pierrejean]

Re : Vba : Limiter l'insertion à une plage donnée

bonjour cibleo

A tester

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

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Bonsoir pierrejean et merci,

çà a l'air de coller,

Ci-dessous, j'ai une deuxième petite macro qui efface mes cellules sélectionnées.

Peux tu également la modifier car j'ai une colonne de dates mal placée, çà m'éviterait une éventuelle boulette ?

Sub Effacer()
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
End Sub

Cibleo

 

[pierrejean]

Re : Vba : Limiter l'insertion à une plage donnée

Re

Ca ne devrait pas avoir l'air de coller , ça doit coller

Même modif sur 2eme macro

Sub Effacer()
 [COLOR=blue]If Not Intersect(Selection, Range("C3:IJ33")) Is Nothing Then[/COLOR]
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
[COLOR=blue]End if[/COLOR]
[COLOR=blue]Exit sub[/COLOR]
[COLOR=blue]MsgBox "Mauvaise Sélection !"
 Range("A1").Select
End Sub[/COLOR]

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Re pierrejean,

Oui, çà colle pierreJean.

Je te remercie.

Une autre petite question : Il apparaît toujours dans la partie supérieure (zone bleue) de la MsgBox le titre Microsoft excel.

Peut on personnaliser cette partie en la remplaçant par le contenu de la cellule A2 de ma feuille de calcul en l'occurence un prénom.

Peut-on modifier le code ?

Bonne soirée

Cibleo

 

[Pierrot93]

Re : Vba : Limiter l'insertion à une plage donnée

Bonjour Cibleo, PierreJean

en l'absence de PierreJean, essaye le code ci dessous :

MsgBox "Mauvaise Sélection !", , Range("C2").Value

bonne soirée
@+

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Bonjour à tous, pierrejean et pierrot93,

Pour répondre à Pierrot93, c'est OK et merci.

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 ?

Merci de votre aide

Cibleo

 

[Pierrot93]

Re : Vba : Limiter l'insertion à une plage donnée

Bonjour Cibleo, PierreJean

si j'ai bien compris, modifies le test comme suit :

If Not Intersect(Selection, Range("C3:IJ33")) Is Nothing And Selection.Count = 1 Then

bonne fin d'après midi
@+

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Bonjour Pierrot93,

Cela ne fonctionne pas.

Par exemple si je sélectionne la plage B3:H3 et j'exécute la macro il m'efface tout au lieu de m'afficher la boite de message "Mauvaise sélection" !!!

Cibleo

 

[Pierrot93]

Re : Vba : Limiter l'insertion à une plage donnée

Re

comprends pas trop chez moi le code ci dessous fonctionne si sélection B3:H3 :

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

@+

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Re Pierrot93,

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.

Cibleo

 

[Pierrot93]

Re : Vba : Limiter l'insertion à une plage donnée

Re

j'avais pas tout compris... Dans ce cas essaye avec une boucle :

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

@+

 

[pierrejean]

Re : Vba : Limiter l'insertion à une plage donnée

Re

La macro de Pierrot exclut les selections de plus d'une cellule

  And Selection.Count = 1

pour effacer

D'autre part Dans B3:H3 il y a C3 d'ou l'effacement

Edit: Ecrit avant le post de Pierrot ci-dessus

Conclusion:

La macro de Pierrot fait bien ce qu'on lui demande

Si tu veux autre chose il est bon de le preciser

 

[cibleo]

Re : Vba : Limiter l'insertion à une plage donnée

Re Pierrot93,

Cette fois ci, çà marche, je crois que l'on s'était mal compris.

Encore merci Pierrot93.

Pour pierrejean, quand je me focalise de trop sur mon projet, je perds de ma lucidité tu sais.

Merci à toi aussi

A bientôt Cibleo