Atribuer une macro à une cellule

1

Bonjour,

J'ai inséré ce code VBA ci-dessous, C'est nickel, mais je voudrais attribuer cette macro à une seule cellule, puis je l'active avec un bouton de commande. Comment faire ?

Public Sub insere_image()
	Dim ficimg As Variant
	ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
	ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
	With Selection.ShapeRange
		.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
		.Top = ActiveCell.Top ' haut de la cellule
		.Left = ActiveCell.Left ' gauche de la cellule
		.Height = ActiveCell.RowHeight ' hauteur de la cellule
		.Width = ActiveCell.Width ' largeur de la cellule
	End With
	With Selection
		.PrintObject = True ' l'objet est imprimé en même temps que le document
		.Placement = xlMoveAndSize ' manière dont l'objet est lié aux cellules
	End With
End Sub

Autre question concernant une macro dans une feuille protégée.

La macro ci-dessus fonctionne quand la feuille n'est pas protégée, mais plus quand je la protège. Quelle est la solution ?

Bonne soirée
Michel

Posté le 2 septembre 2016, 22:07
par Michel
Répondre
0

Bonsoir,


Que voulez-vous dire par une seule cellule ?

Dans votre exemple, vous pouvez remplacer "Selection" par "Activecell" pour désigner la cellule active (parmi les cellules sélectionnées).

Protéger et déprotéger la feuille passe respectivement par les méthodes VBA protect et un protect de l'objet Activesheet.

activesheet.protect password:=""  ', userinterfaceonly:=True

activesheet.unprotect password:=""


Au revoir

Posté le 3 septembre 2016, 18:56
0

Bonjour,

Il faudrait que l'image que j'insère se positionne toujours sur la cellule E15

Bonne journée et déjà merci

Michel


Michel Posté le 5 septembre 2016, 06:15
par Michel
-1

Insérer une image (ActiveX) et puits appliquer le code suivant

Public Sub insere_image()
	Dim My_Pic As String
	My_Pic = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")
	On Error Resume Next
	ActiveSheet.Image1.Picture = LoadPicture(My_Pic)
	On Error GoTo 0
End Sub
Posté le 7 septembre 2016, 12:58
par belkacem

Si vous n'êtes pas inscrit sur le site, vous pouvez poster librement (en tant qu'invité).
Pour cela, indiquez un pseudonyme (nom d'utilisateur) et une adresse email :