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

4 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
Daniel.C
Respect.
Tu as fait très fort.
Daniel
"JB" a écrit dans le message de news:


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
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 -- Masquer le texte des
messages précédents -


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





Avatar
JB
J'ai simplement repris la syntaxe fournie sur Excellabo.

JB
On 23 mar, 15:52, "Daniel.C" wrote:
Respect.
Tu as fait très fort.
Daniel
"JB" a écrit dans le message de news:


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_Im age
           Set myFile = myFolder.Items.Item(fich)
           ActiveCell.Offset(0, 1) = myFolder.GetDetailsOf(m yFile, 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
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:
tp://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 po ur
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'indiqu e la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire un e
autre
macro ? )

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

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 cellul e 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 traiteme nt
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 cell ule
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 -- 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
JB
Pour une seule image, on peut résumer:

Sub TaillePixelsImage()
'Dans outil réferences cocher Microsoft Shell Controls and Automation
chemin = ThisWorkbook.Path
fichier = "catwoman.jpg"
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(chemin)
Set myFile = myFolder.Items.Item(fichier)
MsgBox myFolder.GetDetailsOf(myFile, 26)
End Sub

Malheureusement, ça ne fonctionne pas sous forme d'une fonction.

JB

On 23 mar, 15:52, "Daniel.C" wrote:
Respect.
Tu as fait très fort.
Daniel
"JB" a écrit dans le message de news:


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_Im age
           Set myFile = myFolder.Items.Item(fich)
           ActiveCell.Offset(0, 1) = myFolder.GetDetailsOf(m yFile, 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
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:
tp://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 po ur
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'indiqu e la
taille
en pixel, de l'image trouvée dans une autre colonne (ou faire un e
autre
macro ? )

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

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 cellul e 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 traiteme nt
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 cell ule
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 -- 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
catochem
Houra, ça fonctionne en pixel en changeant ajoutant Microsoft Shell...

Merci à tous

"Daniel.C" a écrit dans le message de news:

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 -








1 2