Taille image en pixel dans macro

Le
catochem
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop



Merci d'avance
Catochem
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #5331451
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la tai lle
en pixel, de l'image trouvée dans une autre colonne (ou faire une autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour a ller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
    fich = Dir("C:ProdOrigin" & Nom_Image)
    If fich <> "" Then
        With ActiveCell
        .Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Imag e
        'Se déplace d'une cellule vers le bas pour continuer le traitement
        ActiveCell.Offset(1, 0).Select
        End With
        Else
        ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
        ActiveCell.Offset(1, 0).Select
    End If
' la variable est initialisée avec la nouvelle valeur de la cellule acti ve
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem


catochem
Le #5331421
Merci JB pour votre réactivité mais je le mets où ce code dans ma macro ?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem


JB
Le #5331391
http://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"
Merci JB pour votre réactivité mais je le mets où ce code dans ma ma cro ?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
  TailleImg = ActiveSheet.Shapes(nom).Width & _
   "x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"


Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une autr e
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule ac tive
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



Daniel.C
Le #5331371
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB"
http://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"
Merci JB pour votre réactivité mais je le mets où ce code dans ma macro ?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"


Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -



JB
Le #5331341
Bonjour,

J'obtiens bien le même résultat avec PhotoShop et Dream.

JB
On 23 mar, 13:46, "Daniel.C"
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" :/ /cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
    fich = Dir(rep & Nom_Image)
    If fich <> "" Then
        With ActiveCell
            .Hyperlinks.Add .Range("A1"), rep & Nom_Image
            'Se déplace d'une cellule vers le bas pour conti nuer le
traitement
            ActiveCell.Offset(0, 1).Select
            Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
            ActiveCell = TailleImg(monimage.Name)
            monimage.Delete
            ActiveCell.Offset(1, -1).Select
        End With
        Else
            ActiveCell.Offset(0, 1) = Nom_Image & "pas trouv é"
            ActiveCell.Offset(1, 0).Select
    End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
   Nom_Image = ActiveCell.Value
   Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
  TailleImg = ActiveSheet.Shapes(nom).Width & _
   "x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"


Merci JB pour votre réactivité mais je le mets où ce code dans ma macro ?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une au tre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule po ur aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -




Daniel.C
Le #5331321
A lire l'aide Width et Height renvoient une mesure en points.
Daniel
"JB"
Bonjour,

J'obtiens bien le même résultat avec PhotoShop et Dream.

JB
On 23 mar, 13:46, "Daniel.C"
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" ://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"


Merci JB pour votre réactivité mais je le mets où ce code dans ma macro
?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une
autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -




catochem
Le #5331301
JB,
J'ai bien des points au lieu de pixels
J'ai fait le test avec une image qui indique 307,2x203,52 alors qu'elle fait
1280px X 848px dans photoshop résolution 300

A+

"JB"
Bonjour,

J'obtiens bien le même résultat avec PhotoShop et Dream.

JB
On 23 mar, 13:46, "Daniel.C"
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" ://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"


Merci JB pour votre réactivité mais je le mets où ce code dans ma macro
?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une
autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -




Misange
Le #5331291
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function



Bonjour JB


Ceci donne la taille de la forme contenant la photo et non pas les
dimensions en pixel de la photo elle mêmme.
Pour récupérer ces infos, il faut aller dans les données exif associées
à la photo.
http://www.excelabo.net/moteurs/hitparade.php
http://www.excelabo.net/excel/sortirdiv.php#exif

Misange

JB
Le #5331271
Sub xxx()
'Dans outil réferences cocher Microsoft Shell Controls and Automation
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
Dim myShell As Shell
Dim myFolder As Folder
Dim myFile As FolderItem
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'Chemin = ThisWorkbook.Path
Chemin = "C:ProdOrigin"
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(Chemin)

Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(Chemin & "" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), Chemin & "" & Nom_Image
Set myFile = myFolder.Items.Item(fich)
ActiveCell.Offset(0, 1) = myFolder.GetDetailsOf(myFile, 26)
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

JB

On 23 mar, 14:36, "catochem"
JB,
J'ai bien des points au lieu de pixels
J'ai fait le test avec une image qui indique 307,2x203,52 alors qu'elle fa it
1280px X 848px dans photoshop résolution 300

A+

"JB"
Bonjour,

J'obtiens bien le même résultat avec PhotoShop et Dream.

JB
On 23 mar, 13:46, "Daniel.C"


Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" ://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"
Merci JB pour votre réactivité mais je le mets où ce code dans m a macro
?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 20 07 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une
autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma mac ro :

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellul e
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte de s
messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -





Daniel.C
Le #5331261
J'ai un petit peu de mal avec les pixels... Sur un écran résolution
1024x768, si je redimensionne une image pour qu'elle occupe la moitié de la
hauteur de l'écran, elle occupe 384 pixels en hauteur. Par contre chaque
image possède des dimensions en pixels indépendantes de l'affichage,
visibles dans l'explorer. Est-ce que ce sont ces dimensions que tu souhaites
récupérer ? Si oui, ça ne va pas être simple...
Daniel
"catochem"
JB,
J'ai bien des points au lieu de pixels
J'ai fait le test avec une image qui indique 307,2x203,52 alors qu'elle
fait 1280px X 848px dans photoshop résolution 300

A+

"JB"
Bonjour,

J'obtiens bien le même résultat avec PhotoShop et Dream.

JB
On 23 mar, 13:46, "Daniel.C"
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" ://cjoint.com/?dxmGztsTyj

Sub xxx()
Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
'chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
'rep = ThisWorkbook.Path & ""
rep = "C:ProdOrigin"
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir(rep & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), rep & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le
traitement
ActiveCell.Offset(0, 1).Select
Set monimage = ActiveSheet.Pictures.Insert(rep &
ActiveCell.Offset(0, -1))
ActiveCell = TailleImg(monimage.Name)
monimage.Delete
ActiveCell.Offset(1, -1).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop
End Sub

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

JB

On 23 mar, 11:31, "catochem"


Merci JB pour votre réactivité mais je le mets où ce code dans ma macro
?

Autre chose le fichier joint n'indiqué pas la taille mais #Value
Catochem

"JB"
Bonjour

Function TailleImg(nom)
TailleImg = ActiveSheet.Shapes(nom).Width & _
"x" & ActiveSheet.Shapes(nom).Height
End Function

http://cjoint.com/?dxleeorup2

JB

On 23 mar, 09:56, "catochem"
Bonjour,

J'ai déjà une macro qui inscrit un lien hypertexte dans Excel 2007 à
chaque
fois qu'une image est trouvée, j'aimerais aussi qu'elle m'indique la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire une
autre
macro ? )

Peut-on m'aider sachant que je ne connais rien à VB ? Voici ma macro
:

Dim Nom_Image As Variant
Nom_Image = ActiveCell.Value
Dim comp As Variant
Dim Nom_fichier_image As Variant
'Déclaration de la variable récupérant le texte de la cellule pour
aller
chercher l 'image correspondante
' Exécute la boucle jusqu'à la première cellule vide
Do Until Nom_Image = ""
' la variable sera égale à la valeur de la cellule active
fich = Dir("C:ProdOrigin" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:ProdOrigin" & Nom_Image
'Se déplace d'une cellule vers le bas pour continuer le traitement
ActiveCell.Offset(1, 0).Select
End With
Else
ActiveCell.Offset(0, 1) = Nom_Image & "pas trouvé"
ActiveCell.Offset(1, 0).Select
End If
' la variable est initialisée avec la nouvelle valeur de la cellule
active
Nom_Image = ActiveCell.Value
Set Nom_fichier_image = Nothing
Loop

Merci d'avance
Catochem- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -- Masquer le texte des
messages précédents -


- Afficher le texte des messages précédents -








Publicité
Poster une réponse
Anonyme