Renommer une image

re
J'ai trouver cette solution en m'aidant d'un sujet du forum.
Il y a peut être plus court mais bon!

solution mise ne place:
Private Sub CommandButton3_Click()
Dim img As Object

'supppression de l'image logosi elle existe
On Error Resume Next
Sheets("accueil").Shapes("logo").Delete

'Chemin dans le textbox
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
UserForm3.TextBox6.Text = .SelectedItems(1)
End With
Set img = Sheets("accueil").Pictures.Insert(UserForm3.TextBox6.Text)

'Renomme l'image
img.Name = "logo"

'Place l'image
img.Top = Sheets("accueil").Range("A1").Top
img.Left = Sheets("accueil").Range("A1").Left
End Sub


Salutations

JP

Bonjour,

essaie ceci :

'-------------------------------------------
Private Sub CommandButton3_Click()

Dim T As Variant

On Error Resume Next

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
T = .SelectedItems(1)
'Si l'usager clique sur le bouton
'annuler, la procédure est terminée ici.
If IsEmpty(T) Then Exit Sub
UserForm3.TextBox6.Text = T
End With

Application.ScreenUpdating = False

With Worksheets("Feuil1")
'Supprimer l'image appelée "Logo" si elle existe
.Shapes("Logo").Delete
'Insère la future image qui sera nommée "logo"
'Appelle la procédure "Insérer.." , tu dois indiquer
'le nom de l'onglet, la plage de cellules que devra
'couvrir l'image et le chemin et le nom du fichier image.
Call InsérerImage(.Name, .Range("B10:F15"), T)
End With

Application.ScreenUpdating = True

End Sub
'-------------------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As Variant)
Dim Rg As Range, Image As Object
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
With Rg
'Détermine la largeur et la largeur qu'aura l'étendue
'de l'image selon la plage de cellules à couvrir
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
Image.Name = "Logo" '<<<<< Nom de la shape (image)
End With
With Image
'True or false selon si l'image doit conserver
'les mêmes proportions entre hauteur et largeur
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'Largeur de l'image
.Width = Largeur
'Hauteur de l'image
.Height = Hauteur
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
'Verrouillé ou pas
.Locked = True 'or False
End With
Set Rg = Nothing
End Sub
'-------------------------------------------




MichD
---------------------------------------------------------------
"JP" a écrit dans le message de groupe de discussion :
a0a6f9de-383c-4fae-b69c-349a9f121c4a@googlegroups.com...

Bonjour,

Je vais chercher une image à l'aide d'un bouton "parcourir" d'un userform.
L'image se met en place correctement.
Je voudrais la nommer "Logo" pour éventuellement la supprimer si elle existe
déjà en A1 dans la feuil1.
Voici le code que j'utilise.


Private Sub CommandButton3_Click()' bouton parcourir de l'userform3

Dim img As Object
' placer le chemin dans la textbox

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
UserForm3.TextBox6.Text = .SelectedItems(1)
End With

'Place l'image en A1 feuil1
Set img = Sheets("feuil1").Pictures.Insert(UserForm3.TextBox6.Text)
img.Top = Sheets("feuil1").Range("A1").Top
img.Left = Sheets("feuil1").Range("A1").Left

' comment renommer l'image
'
'
End Sub


Quel code ajouter pour:
1) la supprimer si elle existe déjà
2) comment la renommer

Merci d'avance

JP

Bonsoir Denis,

Je vais tester dès que possible.

Merci

JP