Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Taille image en pixel dans macro

Taille image en pixel dans macro

14 réponses
Avatar
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:\Prod\Origin\" & Nom_Image)
If fich <> "" Then
With ActiveCell
.Hyperlinks.Add .Range("A1"), "C:\Prod\Origin\" & 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
Signaler un problème avec ce contenu

10 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
1 2
Avatar
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" wrote:
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


Avatar
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" a écrit dans le message de news:

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" wrote:
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


Avatar
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" wrote:
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" a écrit dans le message de news:

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" wrote:



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 -



Avatar
Daniel.C
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:

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" wrote:
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" a écrit dans le message de news:

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" wrote:



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 -



Avatar
JB
Bonjour,

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

JB
On 23 mar, 13:46, "Daniel.C" wrote:
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:
:/ /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" wrote:



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" a écrit dans le message de news:

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" wrote:

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 -




Avatar
Daniel.C
A lire l'aide Width et Height renvoient une mesure en points.
Daniel
"JB" a écrit dans le message de news:

Bonjour,

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

JB
On 23 mar, 13:46, "Daniel.C" wrote:
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:
://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" wrote:



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" a écrit dans le message de news:

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" wrote:

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 -




Avatar
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" a écrit dans le message de news:

Bonjour,

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

JB
On 23 mar, 13:46, "Daniel.C" wrote:
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:
://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" wrote:



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" a écrit dans le message de news:

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" wrote:

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 -




Avatar
Misange
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

Avatar
JB
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" wrote:
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" a écrit dans le message de news:

Bonjour,

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

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



Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:
://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" wrote:

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" a écrit dans le message de news:

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" wrote:

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 -





Avatar
Daniel.C
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" a écrit dans le message de news:

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" a écrit dans le message de news:

Bonjour,

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

JB
On 23 mar, 13:46, "Daniel.C" wrote:
Salut JB.
C'est la taille en points que tu fournis.
Daniel
"JB" a écrit dans le message de news:
://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" wrote:



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" a écrit dans le message de news:

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" wrote:

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 -








1 2