Photos

essaie avec
".jpg"
au lieu de
".jpeg"

isabelle

Le 2016-04-19 15:33, Manu a écrit :

Le message erreur est : La méthode Insert de la classe pictures à échoué


"isabelle" a écrit dans le message de groupe de discussion :
nf60po$1q8t$1@gioia.aioe.org...

je viens tous juste de voir que tu as mis un espace en trop
CheminImage = "C:Photo " & Cells(rw, 1) & ".jpeg"
entre le dernier et le guillemet
isabelle

Le 2016-04-19 15:17, isabelle a écrit :

je ne vois pas, la macro débute bien à la ligne 2
For i = 2 To ......
quel est le message d'erreur lorsque ça bloque ?
isabelle

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel
antivirus Avast.
https://www.avast.com/antivirus

Bonjour,

Je l'ai fais aussi...


"isabelle" a écrit dans le message de groupe de discussion :
nf64ge$nv$1@gioia.aioe.org...

essaie avec
".jpg"
au lieu de
".jpeg"

isabelle

Le 2016-04-19 15:33, Manu a écrit :

Le message erreur est : La méthode Insert de la classe pictures à échoué


"isabelle" a écrit dans le message de groupe de discussion :
nf60po$1q8t$1@gioia.aioe.org...

je viens tous juste de voir que tu as mis un espace en trop
CheminImage = "C:Photo " & Cells(rw, 1) & ".jpeg"
entre le dernier et le guillemet
isabelle

Le 2016-04-19 15:17, isabelle a écrit :

je ne vois pas, la macro débute bien à la ligne 2
For i = 2 To ......
quel est le message d'erreur lorsque ça bloque ?
isabelle

---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel
antivirus Avast.
https://www.avast.com/antivirus

---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Bonjour,


'--------------------------------------------
Sub TestMonImage()
Dim Rg As Range, Ext As String, Sh As Worksheet
Dim PathImg As String, Fichier As String

'///// Variables à adapter \\\

'Chemin où sont situées les images à adapter...
PathImg = "C:UsersmichdPictures"

'Si le nom des fichiers en colonne A ne contient pas
'l'extension, il faut l'ajouter
Ext = ".png" 'Extension des fichiers images

'nom de l'onglet de la feuille oû on doit insérer l'image
Set Sh = Worksheets("Feuil1")

'*************************************************

With Sh 'Nom de la propriété Name l'objet Worksheet
'Détermine la plage où sont les noms des images
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

For Each c In Rg
If c <> "" Then
'Feuil1 = nom de l'onglet de la feuille oû on doit insérer l'image
'C.Offset(, 4) cellule où est insérée l'image, Colonne E
Fichier = PathImg & Trim(c.Value)
If Right(Fichier, Len(Ext)) <> Ext Then
InsérerImage Sh, c.Offset(, 4), Fichier
Else
InsérerImage Sh, c.Offset(, 4), Fichier
End If
End If
Next
End Sub
'--------------------------------------------
Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String)
On Error Resume Next
Dim Image As Picture
With Sh
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Pictures.Insert(NomImage)
If TypeName(Image) <> "Picture" Then Exit Sub
End With
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'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
'--------------------------------------------

Le 20/04/16 07:12, MichD a écrit :

If Right(Fichier, Len(Ext)) <> Ext Then

Tu devrais modifier cette ligne de code comme ceci afin
d'éviter le problème des minuscules et majuscules entre
ces 2 expressions lors de la comparaison...à moins d'avoir
cette expression dans le haut du module où tu insères le code

Option Compare 'Haut du module

sinon :

If Lcase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then

Bonsoir,

Merci Mich,

Mon tableau est sur la feuil2
En colonne A j'ai les noms des images : 1.jpeg ; 2.jpeg etc....
Je rapelle que mes photos sont dans un dossier Photo qui se trouve
directement sur C: et que les noms de photos sont : 1 ; 2 ; 3 etc....

J'ai adapté ton code ainsi mais ca ne fonctionne pas en revanche, je n'ai
aucun débogage, il ne se passe tout simplement rien.

Sub TestMonImage()
Dim Rg As Range, Ext As String, Sh As Worksheet
Dim PathImg As String, Fichier As String

'///// Variables à adapter \\\

'Chemin où sont situées les images à adapter...
PathImg = "C:Photo"

'Si le nom des fichiers en colonne A ne contient pas
'l'extension, il faut l'ajouter
Ext = ".jpeg" 'Extension des fichiers images

'nom de l'onglet de la feuille oû on doit insérer l'image
Set Sh = Worksheets("Feuil2")

'*************************************************

With Sh 'Nom de la propriété Name l'objet Worksheet
'Détermine la plage où sont les noms des images
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

For Each C In Rg
If C <> "" Then
'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image
'C.Offset(, 4) cellule où est insérée l'image, Colonne E
Fichier = PathImg & Trim(C.Value)
'If Right(Fichier, Len(Ext)) <> Ext Then
If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then
InsérerImage Sh, C.Offset(, 4), Fichier
Else
InsérerImage Sh, C.Offset(, 4), Fichier
End If
End If
Next
End Sub
'--------------------------------------------
Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String)
On Error Resume Next
Dim Image As Picture
With Sh
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Pictures.Insert(NomImage)
If TypeName(Image) <> "Picture" Then Exit Sub
End With
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'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

Merci

Manu
"MichD" a écrit dans le message de groupe de discussion :
nf7un6$l6d$1@gioia.aioe.org...

Le 20/04/16 07:12, MichD a écrit :

If Right(Fichier, Len(Ext)) <> Ext Then

Tu devrais modifier cette ligne de code comme ceci afin
d'éviter le problème des minuscules et majuscules entre
ces 2 expressions lors de la comparaison...à moins d'avoir
cette expression dans le haut du module où tu insères le code

Option Compare 'Haut du module

sinon :

If Lcase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Attention aux coupures de ligne de code
par le service de messagerie...

'--------------------------------------------
Sub TestMonImage()
Dim Rg As Range, Ext As String, Sh As Worksheet
Dim PathImg As String, Fichier As String

'///// Variables à adapter \\\

'Chemin où sont situées les images à adapter...
PathImg = "C:Photo"

'Si le nom des fichiers en colonne A ne contient pas
'l'extension, il faut l'ajouter
Ext = ".jpeg" 'Extension des fichiers images

'nom de l'onglet de la feuille oû on doit insérer l'image
Set Sh = Worksheets("Feuil2")

'*************************************************

With Sh 'Nom de la propriété Name l'objet Worksheet
'Détermine la plage où sont les noms des images
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

For Each c In Rg
If c <> "" Then
'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image
'C.Offset(, 4) cellule où est insérée l'image, Colonne E
Fichier = PathImg & Trim(c.Value)
'If Right(Fichier, Len(Ext)) <> Ext Then
If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then
Fichier = Fichier & Ext
End If
If Dir(Fichier, vbNormal) = "" Then
MsgBox "Ce fichier """ & Trim(c) & """ n'exite pas dans ce
répertoire """ & PathImg & "."""
'Si tu désires arrêter la procédure dans un tel cas...
'End Sub
End If
InsérerImage Sh, c.Offset(, 4), Fichier
End If
Next
End Sub
'--------------------------------------------
Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String)
On Error Resume Next
Dim Image As Picture
With Sh
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Pictures.Insert(NomImage)
If TypeName(Image) <> "Picture" Then Exit Sub
End With
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'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
Application.ScreenUpdating = True
Set Rg = Nothing
End Sub

je n'avais pas compris que les nom de fichier en colonne A était inscrit avec
l'extension.

Sub Test()
Dim CheminImage As String, rw As Integer
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
CheminImage = "C:........chemin.... " & Cells(rw, 1)
ActiveSheet.Pictures.Insert (CheminImage)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Top = Cells(rw, 5).Top
.Left = Cells(rw, 5).Left
.Width = Cells(rw, 5).Width
.Height = Cells(rw, 5).Height
End With
Next
End Sub

isabelle

Bonsoir Isabelle,

Ca bloque toujours à cette ligne : ActiveSheet.Pictures.Insert (CheminImage)

Merci beaucoup de votre aide, la procédure de Mich Fonctionne.

Bonne soirée

Manu

Sub Test2()
Dim CheminImage As String, rw As Integer
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
CheminImage = "C:Photo" & Cells(rw, 1)
ActiveSheet.Pictures.Insert (CheminImage)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Top = Cells(rw, 5).Top
.Left = Cells(rw, 5).Left
.Width = Cells(rw, 5).Width
.Height = Cells(rw, 5).Height
End With
Next
End Sub
"isabelle" a écrit dans le message de groupe de discussion :
nf8thd$bit$2@gioia.aioe.org...

je n'avais pas compris que les nom de fichier en colonne A était inscrit
avec
l'extension.

Sub Test()
Dim CheminImage As String, rw As Integer
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
CheminImage = "C:........chemin.... " & Cells(rw, 1)
ActiveSheet.Pictures.Insert (CheminImage)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Top = Cells(rw, 5).Top
.Left = Cells(rw, 5).Left
.Width = Cells(rw, 5).Width
.Height = Cells(rw, 5).Height
End With
Next
End Sub

isabelle


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

Merci beaucoup Mich,

Ca fonctionne nickel !!!

Bonne soirée à tous

Manu

"MichD" a écrit dans le message de groupe de discussion :
5717DAC3.7050001@Hotmail.com...

Attention aux coupures de ligne de code
par le service de messagerie...

'--------------------------------------------
Sub TestMonImage()
Dim Rg As Range, Ext As String, Sh As Worksheet
Dim PathImg As String, Fichier As String

'///// Variables à adapter \\\

'Chemin où sont situées les images à adapter...
PathImg = "C:Photo"

'Si le nom des fichiers en colonne A ne contient pas
'l'extension, il faut l'ajouter
Ext = ".jpeg" 'Extension des fichiers images

'nom de l'onglet de la feuille oû on doit insérer l'image
Set Sh = Worksheets("Feuil2")

'*************************************************

With Sh 'Nom de la propriété Name l'objet Worksheet
'Détermine la plage où sont les noms des images
Set Rg = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

For Each c In Rg
If c <> "" Then
'Feuil2 = nom de l'onglet de la feuille oû on doit insérer l'image
'C.Offset(, 4) cellule où est insérée l'image, Colonne E
Fichier = PathImg & Trim(c.Value)
'If Right(Fichier, Len(Ext)) <> Ext Then
If LCase(Right(Fichier, Len(Ext))) <> LCase(Ext) Then
Fichier = Fichier & Ext
End If
If Dir(Fichier, vbNormal) = "" Then
MsgBox "Ce fichier """ & Trim(c) & """ n'exite pas dans ce
répertoire """ & PathImg & "."""
'Si tu désires arrêter la procédure dans un tel cas...
'End Sub
End If
InsérerImage Sh, c.Offset(, 4), Fichier
End If
Next
End Sub
'--------------------------------------------
Sub InsérerImage(Sh As Worksheet, Rg As Range, NomImage As String)
On Error Resume Next
Dim Image As Picture
With Sh
Largeur = Rg.Offset(, 1)(, Rg.Columns.Count).Left - Rg.Left
Hauteur = Rg.Offset(Rg.Rows.Count).Top - Rg(1).Top
Set Image = .Pictures.Insert(NomImage)
If TypeName(Image) <> "Picture" Then Exit Sub
End With
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'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
Application.ScreenUpdating = True
Set Rg = Nothing
End Sub


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus

J'ai compris pourquoi ca ne fonctionnait pas Isabelle, il suffisait d'un
seul fichier dans le dossier photo qui ne correspondait pas au nom de ma
colonne A pour que ca bug. En revanche si tout correspond, ca fonctionne
parfaitement.

Encore Merci

Manu

"Manu" a écrit dans le message de groupe de discussion :
nfat64$1a1a$1@gioia.aioe.org...


Bonsoir Isabelle,

Ca bloque toujours à cette ligne : ActiveSheet.Pictures.Insert (CheminImage)

Merci beaucoup de votre aide, la procédure de Mich Fonctionne.

Bonne soirée

Manu

Sub Test2()
Dim CheminImage As String, rw As Integer
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
CheminImage = "C:Photo" & Cells(rw, 1)
ActiveSheet.Pictures.Insert (CheminImage)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Top = Cells(rw, 5).Top
.Left = Cells(rw, 5).Left
.Width = Cells(rw, 5).Width
.Height = Cells(rw, 5).Height
End With
Next
End Sub
"isabelle" a écrit dans le message de groupe de discussion :
nf8thd$bit$2@gioia.aioe.org...

je n'avais pas compris que les nom de fichier en colonne A était inscrit
avec
l'extension.

Sub Test()
Dim CheminImage As String, rw As Integer
For rw = 2 To Cells(Rows.Count, 1).End(xlUp).Row
CheminImage = "C:........chemin.... " & Cells(rw, 1)
ActiveSheet.Pictures.Insert (CheminImage)
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
.LockAspectRatio = msoFalse
.Top = Cells(rw, 5).Top
.Left = Cells(rw, 5).Left
.Width = Cells(rw, 5).Width
.Height = Cells(rw, 5).Height
End With
Next
End Sub

isabelle


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus