Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Automatiser l'insertion de photo

Automatiser l'insertion de photo

5 réponses
Avatar
Michele Severac Dumont
Bonjour á tous

Dans une feuille je dois insérer des photos dans les cellules ( C5, F5, I5
etc) dont leur nom est en relation avec le numero (C3, F3, I3…..) . Pour
le moment tout se fait de la facon la plus simple(menu insert->picture->From
file…..) J'aimerais que tout se fasse automatiquement.
Par exemple si dans la cellule C3 j'introduis le numero 6546, j'aimerais
que la photo 6546.jpg qui se trouve dans un répertoire "c:\photos"
apparaisse automatiquement dans la cellule C5 et ainsi successivement. Je
précise que le numero introduit dans les cellules C3,F3,I3,C10…… peut
changer, ce qui fait que la photo ne sera plus la meme. On me parle de macro
mais comment faire, je n'ai aucune idée.

Voici comment est ma feuile

Numero : C3 F3 I3
Photo : C5 F5 I5

Numero : C10 F10 I10
Photo : C12 F12 I12

Numero : C17 F17 I17
Photo : C19 F19 I19

Numero : C24 F24 I24
Photo : C26 F26 I26


Je vous remercie pour l'interet et le temps dédié a mon probleme

Michele
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Michele,


Voici 2 procédures à coller dans la feuille module où l'action se déroule.
Un clic droit sur l'onglet de la feuille désirée, dans le menu contextuel, visualiser le code
copie ce qui suit dans la plage blanche :

Après avoir copié ces 2 procédures, vérifie que la valeur de la variable "Rep" est bien défini dans la première
procédure.
Il ne te reste qu'à écrire dans les cellules désignées, le code de la photo.

'------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rg As Range, Rg1 As Range, Img As String, Rep As String
Set Rg = Range("C3,F3,I3,C10,F10,I10,C17,F17,I17,C24,F24,I24")

Rep = "C:Photos" ' à définir répertoire des photos

On Error Resume Next
Set Rg1 = Intersect(Target, Rg)
If Not Rg1 Is Nothing Then
For Each c In Rg1
Shapes(c.Offset(2).Address(0, 0)).Delete
Img = Rep & c.Value
If Dir(Img) <> "" Then
InsérerImage Rg1.Parent.Name, c.Offset(2), Img
End If
Next
End If

End Sub
'------------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As String)

Dim Rg As Range
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
With Rg
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
End With
With Image
.Left = Rg.Left
.Top = Rg.Top
.Name = Rg.Address(0, 0)
'Largeur de l'image
Image.Width = Largeur
'Hauteur de l'image
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
'------------------------------------


Salutations!



"Michele Severac Dumont" a écrit dans le message de news:
Bonjour á tous

Dans une feuille je dois insérer des photos dans les cellules ( C5, F5, I5
etc) dont leur nom est en relation avec le numero (C3, F3, I3...) . Pour
le moment tout se fait de la facon la plus simple(menu insert->picture->From
file...) J'aimerais que tout se fasse automatiquement.
Par exemple si dans la cellule C3 j'introduis le numero 6546, j'aimerais
que la photo 6546.jpg qui se trouve dans un répertoire "c:photos"
apparaisse automatiquement dans la cellule C5 et ainsi successivement. Je
précise que le numero introduit dans les cellules C3,F3,I3,C10.. peut
changer, ce qui fait que la photo ne sera plus la meme. On me parle de macro
mais comment faire, je n'ai aucune idée.

Voici comment est ma feuile

Numero : C3 F3 I3
Photo : C5 F5 I5

Numero : C10 F10 I10
Photo : C12 F12 I12

Numero : C17 F17 I17
Photo : C19 F19 I19

Numero : C24 F24 I24
Photo : C26 F26 I26


Je vous remercie pour l'interet et le temps dédié a mon probleme

Michele
Avatar
FxM
Bonsoir Michèle,

A tester et adapter :

Sub Macro1()
With ActiveSheet
For col = 3 To 9 Step 3
For lig = 3 To 24 Step 7
.Cells(lig, col).Offset(2, 0).Select
.Pictures.Insert("d:inbox" & .Cells(lig, col).Value).Select
Next lig
Next col
End With
End Sub

@+
FxM


Michele Severac Dumont wrote:

Bonjour á tous

Dans une feuille je dois insérer des photos dans les cellules ( C5, F5, I5
etc) dont leur nom est en relation avec le numero (C3, F3, I3�..) . Pour
le moment tout se fait de la facon la plus simple(menu insert->picture->From
file�..) J'aimerais que tout se fasse automatiquement.
Par exemple si dans la cellule C3 j'introduis le numero 6546, j'aimerais
que la photo 6546.jpg qui se trouve dans un répertoire "c:photos"
apparaisse automatiquement dans la cellule C5 et ainsi successivement. Je
précise que le numero introduit dans les cellules C3,F3,I3,C10�� peut
changer, ce qui fait que la photo ne sera plus la meme. On me parle de macro
mais comment faire, je n'ai aucune idée.

Voici comment est ma feuile

Numero : C3 F3 I3
Photo : C5 F5 I5

Numero : C10 F10 I10
Photo : C12 F12 I12

Numero : C17 F17 I17
Photo : C19 F19 I19

Numero : C24 F24 I24
Photo : C26 F26 I26


Je vous remercie pour l'interet et le temps dédié a mon probleme

Michele




Avatar
FxM
Deux ch'tites corrections :
- le chemin d'accès non modifiée après test
- l'extension de fichier oubliée

Remplacer
.Pictures.Insert("d:inbox" & .Cells(lig, col).Value).Select


par
nom = "c:photo" & .Cells(lig, col).Value & ".jpg"
.Pictures.Insert(nom).Select


et ça devrait aller.

@+
FxM




FxM wrote:

Bonsoir Michèle,

A tester et adapter :

Sub Macro1()
With ActiveSheet
For col = 3 To 9 Step 3
For lig = 3 To 24 Step 7
.Cells(lig, col).Offset(2, 0).Select
.Pictures.Insert("d:inbox" & .Cells(lig, col).Value).Select
Next lig
Next col
End With
End Sub

@+
FxM


Michele Severac Dumont wrote:

Bonjour á tous

Dans une feuille je dois insérer des photos dans les cellules ( C5,
F5, I5
etc) dont leur nom est en relation avec le numero (C3, F3, I3�..) .
Pour
le moment tout se fait de la facon la plus simple(menu
insert->picture->From
file�..) J'aimerais que tout se fasse automatiquement.
Par exemple si dans la cellule C3 j'introduis le numero 6546, j'aimerais
que la photo 6546.jpg qui se trouve dans un répertoire "c:photos"
apparaisse automatiquement dans la cellule C5 et ainsi
successivement. Je
précise que le numero introduit dans les cellules C3,F3,I3,C10�� peut
changer, ce qui fait que la photo ne sera plus la meme. On me parle de
macro
mais comment faire, je n'ai aucune idée.

Voici comment est ma feuile

Numero : C3 F3 I3
Photo : C5 F5 I5

Numero : C10 F10 I10
Photo : C12 F12 I12

Numero : C17 F17 I17
Photo : C19 F19 I19

Numero : C24 F24 I24
Photo : C26 F26 I26


Je vous remercie pour l'interet et le temps dédié a mon probleme

Michele






Avatar
michdenis
si dans la cellule tu inscris seulement le code de l'image sans son extension de fichier,

remplace cette ligne de code dans la procédure :

Img = Rep & c.Value

par

Img = Rep & c.Value & ".jpg"


Salutations!


"michdenis" a écrit dans le message de news:%
Bonjour Michele,


Voici 2 procédures à coller dans la feuille module où l'action se déroule.
Un clic droit sur l'onglet de la feuille désirée, dans le menu contextuel, visualiser le code
copie ce qui suit dans la plage blanche :

Après avoir copié ces 2 procédures, vérifie que la valeur de la variable "Rep" est bien défini dans la première
procédure.
Il ne te reste qu'à écrire dans les cellules désignées, le code de la photo.

'------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rg As Range, Rg1 As Range, Img As String, Rep As String
Set Rg = Range("C3,F3,I3,C10,F10,I10,C17,F17,I17,C24,F24,I24")

Rep = "C:Photos" ' à définir répertoire des photos

On Error Resume Next
Set Rg1 = Intersect(Target, Rg)
If Not Rg1 Is Nothing Then
For Each c In Rg1
Shapes(c.Offset(2).Address(0, 0)).Delete
Img = Rep & c.Value
If Dir(Img) <> "" Then
InsérerImage Rg1.Parent.Name, c.Offset(2), Img
End If
Next
End If

End Sub
'------------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As String)

Dim Rg As Range
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
With Rg
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
End With
With Image
.Left = Rg.Left
.Top = Rg.Top
.Name = Rg.Address(0, 0)
'Largeur de l'image
Image.Width = Largeur
'Hauteur de l'image
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
'------------------------------------


Salutations!



"Michele Severac Dumont" a écrit dans le message de news:
Bonjour á tous

Dans une feuille je dois insérer des photos dans les cellules ( C5, F5, I5
etc) dont leur nom est en relation avec le numero (C3, F3, I3...) . Pour
le moment tout se fait de la facon la plus simple(menu insert->picture->From
file...) J'aimerais que tout se fasse automatiquement.
Par exemple si dans la cellule C3 j'introduis le numero 6546, j'aimerais
que la photo 6546.jpg qui se trouve dans un répertoire "c:photos"
apparaisse automatiquement dans la cellule C5 et ainsi successivement. Je
précise que le numero introduit dans les cellules C3,F3,I3,C10.. peut
changer, ce qui fait que la photo ne sera plus la meme. On me parle de macro
mais comment faire, je n'ai aucune idée.

Voici comment est ma feuile

Numero : C3 F3 I3
Photo : C5 F5 I5

Numero : C10 F10 I10
Photo : C12 F12 I12

Numero : C17 F17 I17
Photo : C19 F19 I19

Numero : C24 F24 I24
Photo : C26 F26 I26


Je vous remercie pour l'interet et le temps dédié a mon probleme

Michele
Avatar
Michele Severac Dumont
Bonsoir
Un grand merci á michdenis et FxM. Je vais essayer vos codes. C'est la
premiere fois que je me lance dans une macro, donc si je suis bloquée, je
ferai appel

Michele