En r=E9f=E9rence au message de Denis Michon"=20
<denis.michon@cgocable.ca>....
Cette fonction est vraiment terrible ! Merci !
Mais j'essaie vainement d'apporter une petite modif, mais=20
cela ne fonctionne pas !
En fait je voudrais =E0 la fin de la macro appliquer la=20
taille de l'image =E0 la taille de la cellule, =E0 savoir si=20
l'image fait 375 x 372 pixels je voudrais que ma cellule=20
soit redimensionn=E9e avec ces valeurs.
Voir le code que j'ai rajout=E9 ci dessous, marqu=E9 par $$$=20
(Les $$$ ne sont pas dans mon code c'est juste pour=20
rep=E9rer mes modifs ici !)
> Bonjour Christian,
>=20
> 'Un merci =E0 Denis Pasquier (mpfe) pour l'api que j'ai=20
modifi=E9 pour ton probl=E8me.
>=20
> Voici une fa=E7on de faire :
>=20
> Tu appelles la proc=E9dure : Sub Ins=E9rerUnImage()
>=20
> Tu prends soin de d=E9finir les variables suivantes selon=20
ton projet.
> A ) Chemin
> B ) Filtre
> C ) Feuille
> D ) Plage
>=20
>=20
> Dans le haut d'un module standard : D=E9claration de l'api
> '-------------------
> Declare Function GetOpenFileName Lib "comdlg32.dll" _
> Alias "GetOpenFileNameA" (pOpenfilename As=20
OPENFILENAME) As Long
>=20
> Private Type OPENFILENAME
> lStructSize As Long
> hwndOwner As Long
> hInstance As Long
> lpstrFilter As String
> lpstrCustomFilter As String
> nMaxCustFilter As Long
> nFilterIndex As Long
> lpstrFile As String
> nMaxFile As Long
> lpstrFileTitle As String
> nMaxFileTitle As Long
> lpstrInitialDir As String
> lpstrTitle As String
> flags As Long
> nFileOffset As Integer
> nFileExtension As Integer
> lpstrDefExt As String
> lCustData As Long
> lpfnHook As Long
> lpTemplateName As String
> End Type
>=20
> Private Function SelectAFile(Chemin As String, Optional=20
Filtre As String =3D "*.*") As String
> Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter=20
As String
> OpenFile.lStructSize =3D Len(OpenFile)
> sFilter =3D "Tous les fichiers (" & Filtre & ")" & Chr
(0) & Filtre & Chr(0)
> With OpenFile
> .lpstrFilter =3D sFilter
> .nFilterIndex =3D 1
> .lpstrFile =3D String(257, 0)
> .nMaxFile =3D Len(OpenFile.lpstrFile) - 1
> .lpstrFileTitle =3D OpenFile.lpstrFile
> .nMaxFileTitle =3D OpenFile.nMaxFile
> .lpstrInitialDir =3D Chemin
> .lpstrTitle =3D "Vos images"
> .flags =3D 0
> End With
> lReturn =3D GetOpenFileName(OpenFile)
> If lReturn =3D 0 Then
> SelectAFile =3D "erann"
> Else
> SelectAFile =3D Trim(Left(OpenFile.lpstrFile, _
> InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
> End If
> End Function
>=20
>=20
>=20
> '--------------------------------------
> Sub Ins=E9rerUnImage()
>=20
> Dim Image As Variant, Chemin As String
> Dim Filtre As String, Feuille As String, Plage As Range
>=20
> 'r=E9pertoire =E0 l'ouverture
> Chemin =3D "C:\Excel"
>=20
> 'Extensions des fichiers =E0 lister du r=E9pertoire
> Filtre =3D "*.Jpg;*.bmp;*.ico"
>=20
> 'O=F9 sera copier l'image :
> 'Nom de la feuille du classeur
> Feuille =3D "Feuil2"
>=20
> '=C9tendue de la plage qui sera recouverte par l'image
> 'Set Plage =3D Range("b5:D6")
=20
$$$ Set Plage =3D ActiveCell
>=20
> Image =3D SelectAFile(Chemin, Filtre)
> If Image <> "erann" Then
> 'Ins=E9rerImage Feuille, Range("b5:D6"), Image
Ins=E9rerImage Feuille, ActiveCell, Image
> End If
>=20
> End Sub
> '--------------------------------------
>=20
>=20
> Sub Ins=E9rerImage(Feuille As String, RgImage As Range,=20
NomImage As Variant)
> Dim Rg As Range
> Set Rg =3D Worksheets(Feuille).Range(RgImage.Address)
> With Rg
> Largeur =3D .Offset(, 1)(, .Columns.Count).Left -
.Left
> Hauteur =3D .Offset(.Rows.Count).Top - .Item
(1).Top
> Set Image =3D Worksheets(Feuille).Pictures.Insert
(NomImage)
> End With
$$$ Ht =3D Image.Width
$$$ Lar =3D Image.Height
> With Image
> .Left =3D Rg.Left
> .Top =3D Rg.Top
> 'Largeur de l'image
> Image.Width =3D Largeur
> 'Hauteur de l'image
> Image.Height =3D Hauteur
> 'Est-ce que l'image doit se d=E9placer avec les=20
cellules
> 'voici les 3 constantes possibles
> .Placement =3D xlFreeFloating 'or xlmove or=20
xlMoveAndSize
> 'Verrouill=E9 ou pas
> .Locked =3D True 'or False
> End With
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
Denis Michon
Bonjour Olivier,
C'est particulier comme demande. Je suppose que tu connais par avance la grandeur des images que tu veux insérer ... sinon, il n'y a pas beaucoup de présentation de feuille d'excel qui tolèrerait l'insertion d'images de dimension toutes différentes les unes des autres.
Ceci étant dit, Voici la problématique que soulève ton approche :
La propriété "Width" d'un objet "Range" permet d'obtenir avec précision la largeur de l'objet. L'unité de mesure est le "point". A = Range("A1").Width
La correspondance entre le point et le pixel '1 Point = .75 pixel
Pour définir la largeur d'une colonne, on doit utiliser la propriété "ColumnWidth". Voici l'unité de mesure utilisé par Excel : (Définition en provenance de l'aide d'excel) Range("A1").ColumnWidth = 10
ColumnWidth : Une unité de largeur de colonne est égale à la largeur d'un caractère du style Normal. Dans le cas des polices proportionnelles, la largeur du caractère 0 (zéro) est utilisée.
À la lecture de cette définition, tu vois toute suite le problème que cela cause... si on veut définir avec précision la largeur d'une colonne. Personnellement, je ne connais pas de coefficient de conversion qui soit applicable à toutes les figures (caractères) possibles. Tu dois par conséquent créer une bidouille qui va se contenter d'établir une approximation de la largeur réelle de la colonne.
Voici un exemple de bidouille... il y a sûirement moyen de faire beaucoup mieux, mais je m'en voudrais de te priver de ce plaisir ... à moins que quelqu'un d'autre connaisse une mesure de conversion fiable de "ColumnWidth" en pixel ou en point.
'--------------------------------- Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As Variant) Dim Rg As Range, Rapport As Double Application.ScreenUpdating = False
Set Rg = Worksheets(Feuille).Range(RgImage.Address) Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
With Image .Left = Rg.Left .Top = Rg.Top 'Hauteur de l'image For Each r In Rg.Rows r.RowHeight = (Image.Height / Rg.Rows.Count) Next
'La bidouille... '*--------------------------------------- 'Largeur de l'image Rapport = 7 Do While Rg.Width < Image.Width For Each c In Rg.Columns c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25 Next If Rg.Width < Image.Width Then Rapport = Rapport - 0.002 End If Loop Do While Rg.Width > Image.Width For Each c In Rg.Columns c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25 Next If Rg.Width > Image.Width Then Rapport = Rapport + 0.002 End If Loop '*--------------------------------------- 'Est-ce que l'image doit se déplacer avec les cellules 'voici les 3 constantes possibles .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize 'Verrouillé ou pas .Locked = True 'or False End With Set Rg = Nothing
End Sub '---------------------------------
Salutations!
"Olivier" a écrit dans le message de news:0de501c3a47c$e8fb7740$ Bonjour à tous !
En référence au message de Denis Michon" ....
Cette fonction est vraiment terrible ! Merci !
Mais j'essaie vainement d'apporter une petite modif, mais cela ne fonctionne pas ! En fait je voudrais à la fin de la macro appliquer la taille de l'image à la taille de la cellule, à savoir si l'image fait 375 x 372 pixels je voudrais que ma cellule soit redimensionnée avec ces valeurs.
Voir le code que j'ai rajouté ci dessous, marqué par $$$ (Les $$$ ne sont pas dans mon code c'est juste pour repérer mes modifs ici !)
MERCI D'AVANCE !!!!
Olivier
----- Original Message ----- From: "Denis Michon" Newsgroups: microsoft.public.fr.excel Sent: Saturday, November 01, 2003 5:14 PM Subject: Re: inserer image
Bonjour Christian,
'Un merci à Denis Pasquier (mpfe) pour l'api que j'ai modifié pour ton problème.
Voici une façon de faire :
Tu appelles la procédure : Sub InsérerUnImage()
Tu prends soin de définir les variables suivantes selon ton projet.
A ) Chemin B ) Filtre C ) Feuille D ) Plage
Dans le haut d'un module standard : Déclaration de l'api '------------------- Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type
Private Function SelectAFile(Chemin As String, Optional Filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As String
Set Image = Worksheets(Feuille).Pictures.Insert (NomImage)
End With
$$$ Ht = Image.Width $$$ Lar = Image.Height
With Image .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
$$$ ActiveCell.EntireColumn.ColumnWidth = Lar $$$ ActiveCell.EntireRow.RowHeight = Ht
Set Rg = Nothing
End Sub
Bonjour Olivier,
C'est particulier comme demande. Je suppose que tu connais par avance la grandeur des images que tu veux insérer ...
sinon, il n'y a pas beaucoup de présentation de feuille d'excel qui tolèrerait l'insertion d'images de dimension toutes
différentes les unes des autres.
Ceci étant dit, Voici la problématique que soulève ton approche :
La propriété "Width" d'un objet "Range" permet d'obtenir avec précision la largeur de l'objet. L'unité de mesure est le
"point".
A = Range("A1").Width
La correspondance entre le point et le pixel
'1 Point = .75 pixel
Pour définir la largeur d'une colonne, on doit utiliser la propriété "ColumnWidth". Voici l'unité de mesure utilisé par
Excel : (Définition en provenance de l'aide d'excel) Range("A1").ColumnWidth = 10
ColumnWidth :
Une unité de largeur de colonne est égale à la largeur d'un caractère du style Normal. Dans le cas des polices
proportionnelles, la largeur du caractère 0 (zéro) est utilisée.
À la lecture de cette définition, tu vois toute suite le problème que cela cause... si on veut définir avec précision la
largeur d'une colonne. Personnellement, je ne connais pas de coefficient de conversion qui soit applicable à toutes les
figures (caractères) possibles. Tu dois par conséquent créer une bidouille qui va se contenter d'établir une
approximation de la largeur réelle de la colonne.
Voici un exemple de bidouille... il y a sûirement moyen de faire beaucoup mieux, mais je m'en voudrais de te priver de
ce plaisir ... à moins que quelqu'un d'autre connaisse une mesure de conversion fiable de "ColumnWidth" en pixel ou en
point.
'---------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As Variant)
Dim Rg As Range, Rapport As Double
Application.ScreenUpdating = False
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
With Image
.Left = Rg.Left
.Top = Rg.Top
'Hauteur de l'image
For Each r In Rg.Rows
r.RowHeight = (Image.Height / Rg.Rows.Count)
Next
'La bidouille...
'*---------------------------------------
'Largeur de l'image
Rapport = 7
Do While Rg.Width < Image.Width
For Each c In Rg.Columns
c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25
Next
If Rg.Width < Image.Width Then
Rapport = Rapport - 0.002
End If
Loop
Do While Rg.Width > Image.Width
For Each c In Rg.Columns
c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25
Next
If Rg.Width > Image.Width Then
Rapport = Rapport + 0.002
End If
Loop
'*---------------------------------------
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
'Verrouillé ou pas
.Locked = True 'or False
End With
Set Rg = Nothing
End Sub
'---------------------------------
Salutations!
"Olivier" <anonymous@discussions.microsoft.com> a écrit dans le message de
news:0de501c3a47c$e8fb7740$a301280a@phx.gbl...
Bonjour à tous !
En référence au message de Denis Michon"
<denis.michon@cgocable.ca>....
Cette fonction est vraiment terrible ! Merci !
Mais j'essaie vainement d'apporter une petite modif, mais
cela ne fonctionne pas !
En fait je voudrais à la fin de la macro appliquer la
taille de l'image à la taille de la cellule, à savoir si
l'image fait 375 x 372 pixels je voudrais que ma cellule
soit redimensionnée avec ces valeurs.
Voir le code que j'ai rajouté ci dessous, marqué par $$$
(Les $$$ ne sont pas dans mon code c'est juste pour
repérer mes modifs ici !)
'Un merci à Denis Pasquier (mpfe) pour l'api que j'ai
modifié pour ton problème.
Voici une façon de faire :
Tu appelles la procédure : Sub InsérerUnImage()
Tu prends soin de définir les variables suivantes selon
ton projet.
A ) Chemin
B ) Filtre
C ) Feuille
D ) Plage
Dans le haut d'un module standard : Déclaration de l'api
'-------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Function SelectAFile(Chemin As String, Optional
Filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter
As String
Set Image = Worksheets(Feuille).Pictures.Insert
(NomImage)
End With
$$$ Ht = Image.Width
$$$ Lar = Image.Height
With Image
.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
$$$ ActiveCell.EntireColumn.ColumnWidth = Lar
$$$ ActiveCell.EntireRow.RowHeight = Ht
C'est particulier comme demande. Je suppose que tu connais par avance la grandeur des images que tu veux insérer ... sinon, il n'y a pas beaucoup de présentation de feuille d'excel qui tolèrerait l'insertion d'images de dimension toutes différentes les unes des autres.
Ceci étant dit, Voici la problématique que soulève ton approche :
La propriété "Width" d'un objet "Range" permet d'obtenir avec précision la largeur de l'objet. L'unité de mesure est le "point". A = Range("A1").Width
La correspondance entre le point et le pixel '1 Point = .75 pixel
Pour définir la largeur d'une colonne, on doit utiliser la propriété "ColumnWidth". Voici l'unité de mesure utilisé par Excel : (Définition en provenance de l'aide d'excel) Range("A1").ColumnWidth = 10
ColumnWidth : Une unité de largeur de colonne est égale à la largeur d'un caractère du style Normal. Dans le cas des polices proportionnelles, la largeur du caractère 0 (zéro) est utilisée.
À la lecture de cette définition, tu vois toute suite le problème que cela cause... si on veut définir avec précision la largeur d'une colonne. Personnellement, je ne connais pas de coefficient de conversion qui soit applicable à toutes les figures (caractères) possibles. Tu dois par conséquent créer une bidouille qui va se contenter d'établir une approximation de la largeur réelle de la colonne.
Voici un exemple de bidouille... il y a sûirement moyen de faire beaucoup mieux, mais je m'en voudrais de te priver de ce plaisir ... à moins que quelqu'un d'autre connaisse une mesure de conversion fiable de "ColumnWidth" en pixel ou en point.
'--------------------------------- Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As Variant) Dim Rg As Range, Rapport As Double Application.ScreenUpdating = False
Set Rg = Worksheets(Feuille).Range(RgImage.Address) Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
With Image .Left = Rg.Left .Top = Rg.Top 'Hauteur de l'image For Each r In Rg.Rows r.RowHeight = (Image.Height / Rg.Rows.Count) Next
'La bidouille... '*--------------------------------------- 'Largeur de l'image Rapport = 7 Do While Rg.Width < Image.Width For Each c In Rg.Columns c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25 Next If Rg.Width < Image.Width Then Rapport = Rapport - 0.002 End If Loop Do While Rg.Width > Image.Width For Each c In Rg.Columns c.ColumnWidth = (((Image.Width / Rg.Columns.Count)) / Rapport) * 1.25 Next If Rg.Width > Image.Width Then Rapport = Rapport + 0.002 End If Loop '*--------------------------------------- 'Est-ce que l'image doit se déplacer avec les cellules 'voici les 3 constantes possibles .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize 'Verrouillé ou pas .Locked = True 'or False End With Set Rg = Nothing
End Sub '---------------------------------
Salutations!
"Olivier" a écrit dans le message de news:0de501c3a47c$e8fb7740$ Bonjour à tous !
En référence au message de Denis Michon" ....
Cette fonction est vraiment terrible ! Merci !
Mais j'essaie vainement d'apporter une petite modif, mais cela ne fonctionne pas ! En fait je voudrais à la fin de la macro appliquer la taille de l'image à la taille de la cellule, à savoir si l'image fait 375 x 372 pixels je voudrais que ma cellule soit redimensionnée avec ces valeurs.
Voir le code que j'ai rajouté ci dessous, marqué par $$$ (Les $$$ ne sont pas dans mon code c'est juste pour repérer mes modifs ici !)
MERCI D'AVANCE !!!!
Olivier
----- Original Message ----- From: "Denis Michon" Newsgroups: microsoft.public.fr.excel Sent: Saturday, November 01, 2003 5:14 PM Subject: Re: inserer image
Bonjour Christian,
'Un merci à Denis Pasquier (mpfe) pour l'api que j'ai modifié pour ton problème.
Voici une façon de faire :
Tu appelles la procédure : Sub InsérerUnImage()
Tu prends soin de définir les variables suivantes selon ton projet.
A ) Chemin B ) Filtre C ) Feuille D ) Plage
Dans le haut d'un module standard : Déclaration de l'api '------------------- Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type
Private Function SelectAFile(Chemin As String, Optional Filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As String
Set Image = Worksheets(Feuille).Pictures.Insert (NomImage)
End With
$$$ Ht = Image.Width $$$ Lar = Image.Height
With Image .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
$$$ ActiveCell.EntireColumn.ColumnWidth = Lar $$$ ActiveCell.EntireRow.RowHeight = Ht