Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel VBA: Procédure pour ajouter une image dans une note

VBA: Procédure pour ajouter une image dans une note

22 réponses
Avatar
Emile63
Bonjour Í  tous,

Ajoutant fréquemment des images dans les Notes des cellules (Anciennement les commentaires) j'aimerais automatiser la procédure un peu fastidieuse avec du code VBA, mais je ne vois pas comment le faire...
Si quelqu'un Í  une suggestion, je suis preneur. :-)
Voici un peu le schéma auquel je pense : ---------------------------------
Sub Ajouter image ()
'Insertion d'un commentaire / note a partir de la cellule active.

ActiveCell.AddComment
With ActiveCell.Comment
.Visible = False
.Text Text:=""
' ????
MonCheminImage InputBox
End With

With Selection
.ShapeRange.ScaleWidth 1.85, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 2.78, msoFalse, msoScaleFromTopLeft
' élargir l'image a une largeur de 5 cm avec la hauteur proportionnelle
End with

End Sub

Je vous remercie d'avance pour votre aide,
Bonne journée

Emile
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 3
Avatar
MichD
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.LockAspectRatio = msoTrue
.Shape.Width = 103 * L / 4
End With
End With
Else
MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------
MichD
Avatar
MichD
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
   vbCrLf & "Quelle doit être la largeur de cette image en " & _
   vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
   "Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
    MsgBox "La valeur saisie pour la largeur de l'image " & _
    "est en dehors des bornes permises, entre 3 et 8. " & _
    "Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
    "Largeur de l'image non permise"
    Exit Sub
End If
    With ActiveCell
        .ClearComments
        .AddComment
        With .Comment
            .Visible = True 'or false
            .Text Text:=""
            .Shape.Fill.UserPicture Fichier
            .Shape.LockAspectRatio = msoTrue
            .Shape.Width = 103 * L / 4
        End With
    End With
Else
    MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
    'Définit un titre pour la boÍ®te de dialogue
    .Title = "Choisir le fichier image de ton choix"
    'Empêcher la multisélection
    .AllowMultiSelect = False
     'Répertoire par défaut suivi du type de fichier par défaut
    .InitialFileName = CheminEtTypeFichier
     'Efface les filtres existants.
    .Filters.Clear
     'Définis une liste de filtres pour le champ "Type de fichiers".
     'tu peux ajouter toutes les extensions que tu as besoin
    .Filters.Add "Images", "*.png; *.jpg; *.bmp"
     'Définit le filtre qui s'affiche par
     'défaut dans le champ "Type de fichiers "."
    .FilterIndex = 1
     'Indique le type d'affichage dans la boͮte de dialogue
    '(exemple visualisation des propriétés)
    .InitialView = msoFileDialogViewProperties
     'Affiche la boͮte de dialogue
    .Show
    If .SelectedItems.Count > 0 Then
        BrowseFile = .SelectedItems(1)
    Else
        BrowseFile = ""
    End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD
Avatar
MichD
Le 13/09/21 Í  12:40, MichD a écrit :
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image
demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
    vbCrLf & "Quelle doit être la largeur de cette image en " & _
    vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
    "Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
     MsgBox "La valeur saisie pour la largeur de l'image " & _
     "est en dehors des bornes permises, entre 3 et 8. " & _
     "Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
     "Largeur de l'image non permise"
     Exit Sub
End If
     With ActiveCell
         .ClearComments
         .AddComment
         With .Comment
             .Visible = True 'or false
             .Text Text:=""
             .Shape.Fill.UserPicture Fichier
             .Shape.LockAspectRatio = msoTrue
             .Shape.Width = 103 * L / 4
         End With
     End With
Else
     MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
     'Définit un titre pour la boÍ®te de dialogue
     .Title = "Choisir le fichier image de ton choix"
     'Empêcher la multisélection
     .AllowMultiSelect = False
      'Répertoire par défaut suivi du type de fichier par défaut
     .InitialFileName = CheminEtTypeFichier
      'Efface les filtres existants.
     .Filters.Clear
      'Définis une liste de filtres pour le champ "Type de fichiers".
      'tu peux ajouter toutes les extensions que tu as besoin
     .Filters.Add "Images", "*.png; *.jpg; *.bmp"
      'Définit le filtre qui s'affiche par
      'défaut dans le champ "Type de fichiers "."
     .FilterIndex = 1
      'Indique le type d'affichage dans la boͮte de dialogue
     '(exemple visualisation des propriétés)
     .InitialView = msoFileDialogViewProperties
      'Affiche la boͮte de dialogue
     .Show
     If .SelectedItems.Count > 0 Then
         BrowseFile = .SelectedItems(1)
     Else
         BrowseFile = ""
     End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD

En fait, le résultat est vrai, si ton moniteur Í  24" et qu'il est en HD
1920 X1080.
Selon la grandeur d'écran, le mode d'affichage (1920 X 1080), le nombre
de points Í  l'écran du moniteur varie. Dans mon environnement, l'image a
vraiment le nombre de CM désiré que tu peux mesurer avec une règle.
Regarde Í  cette adresse, tu verras différentes manières d'effectuer des
conversions dans Excel, de centimètres en points, de pouces en points,
points en pixels.
La valeur 108.78 est estimée et ne provient pas de la fonction :
x=application.CentimetersToPoints(B), B étant le nombre de CM
https://exceloffthegrid.com/vba-convert-centimeters-inches-pixels-to-points/
Pour obtenir un vrai 5 CM Í  l'écran (que tu peux mesurer avec une règle)
compte tenu des différentes variables énoncées, la donne est un peu plus
complexe que celle énoncée ici.
La solution énoncée ici ne convient pas Í  tous les environnements.
MichD
Avatar
Emile63
Le Monday, September 13, 2021 Í  7:53:16 PM UTC+2, MichD a écrit :
Le 13/09/21 Í  12:40, MichD a écrit :
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image
demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.LockAspectRatio = msoTrue
.Shape.Width = 103 * L / 4
End With
End With
Else
MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD
En fait, le résultat est vrai, si ton moniteur Í  24" et qu'il est en HD
1920 X1080.
Selon la grandeur d'écran, le mode d'affichage (1920 X 1080), le nombre
de points Í  l'écran du moniteur varie. Dans mon environnement, l'image a
vraiment le nombre de CM désiré que tu peux mesurer avec une règle.
Regarde Í  cette adresse, tu verras différentes manières d'effectuer des
conversions dans Excel, de centimètres en points, de pouces en points,
points en pixels.
La valeur 108.78 est estimée et ne provient pas de la fonction :
x=application.CentimetersToPoints(B), B étant le nombre de CM
https://exceloffthegrid.com/vba-convert-centimeters-inches-pixels-to-points/
Pour obtenir un vrai 5 CM Í  l'écran (que tu peux mesurer avec une règle)
compte tenu des différentes variables énoncées, la donne est un peu plus
complexe que celle énoncée ici.
La solution énoncée ici ne convient pas Í  tous les environnements.
MichD

----------------------------------
Bonjour MichD,
J'ai toujours le problème d'une image non proportionnelle, je t'ai mis un exemple en document joint.
https://www.cjoint.com/c/KIopKcx14kk
Le cadre de l'image mesure bien la taille donnée (5 cm par ex.), mais l'image en question en souffre :(
Est-ce qu'avec du code on arrive Í  géré la boÍ®te de message figurant sur le fichier ci-joint?
Par ailleurs, c'est entre 5 et 15 cm de largeur que je souhaiterais visualiser...
J'avoue ne pas (encore) avoir été au lien que tu me suggères (manque de temps aujourd'hui),
mais ton commentaire : x=application.CentimetersToPoints(B)
me paraÍ®t pile poil ce que je cherche Í  utiliser pour autant que soit résolue cette satanée proportionnalité de l'image :-)
Merci encore pour tes suggestion, et très bonne fin de journée.
Emile
Avatar
MichD
Le 14/09/21 Í  11:46, Emile63 a écrit :
Le Monday, September 13, 2021 Í  7:53:16 PM UTC+2, MichD a écrit :
Le 13/09/21 Í  12:40, MichD a écrit :
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image
demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.LockAspectRatio = msoTrue
.Shape.Width = 103 * L / 4
End With
End With
Else
MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD

En fait, le résultat est vrai, si ton moniteur Í  24" et qu'il est en HD
1920 X1080.
Selon la grandeur d'écran, le mode d'affichage (1920 X 1080), le nombre
de points Í  l'écran du moniteur varie. Dans mon environnement, l'image a
vraiment le nombre de CM désiré que tu peux mesurer avec une règle.
Regarde Í  cette adresse, tu verras différentes manières d'effectuer des
conversions dans Excel, de centimètres en points, de pouces en points,
points en pixels.
La valeur 108.78 est estimée et ne provient pas de la fonction :
x=application.CentimetersToPoints(B), B étant le nombre de CM
https://exceloffthegrid.com/vba-convert-centimeters-inches-pixels-to-points/
Pour obtenir un vrai 5 CM Í  l'écran (que tu peux mesurer avec une règle)
compte tenu des différentes variables énoncées, la donne est un peu plus
complexe que celle énoncée ici.
La solution énoncée ici ne convient pas Í  tous les environnements.
MichD

----------------------------------
Bonjour MichD,
J'ai toujours le problème d'une image non proportionnelle, je t'ai mis un exemple en document joint.
https://www.cjoint.com/c/KIopKcx14kk
Le cadre de l'image mesure bien la taille donnée (5 cm par ex.), mais l'image en question en souffre :(
Est-ce qu'avec du code on arrive Í  géré la boÍ®te de message figurant sur le fichier ci-joint?
Par ailleurs, c'est entre 5 et 15 cm de largeur que je souhaiterais visualiser...
J'avoue ne pas (encore) avoir été au lien que tu me suggères (manque de temps aujourd'hui),
mais ton commentaire : x=application.CentimetersToPoints(B)
me paraÍ®t pile poil ce que je cherche Í  utiliser pour autant que soit résolue cette satanée proportionnalité de l'image :-)
Merci encore pour tes suggestion, et très bonne fin de journée.
Emile

La procédure est basée sur la largeur du commentaire.
Cependant, tu devrais avoir des images proportionnées
aux originaux.
Une dernière version :
fichier joint : https://www.cjoint.com/c/KIos6T2m6sF
'---------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim A As Double, B As Double, C As Double, L As Double
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un
commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et
8 centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
'Insérer un fichier image dans Excel
Set Sh = Feuil2.Shapes.AddPicture(Fichier, False, True,
Range("B2").Left, Range("B2").Top, -1, -1)
A = Sh.Width
B = Application.CentimetersToPoints(L)
If A > B Then
C = B / A
Sh.ScaleWidth C, msoFalse, msoScaleFromTopLeft
Else
C = B / A
Sh.ScaleHeight C, msoFalse, msoScaleFromTopLeft
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.Width = Sh.Width
.Shape.Height = Sh.Height
Sh.Delete
End With
End With
Else
MsgBox "Aucune image a été retenue.", _
vbInformation + vbOKCancel, "Opération annulée."
End If
End Sub
'---------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------
MichD
Avatar
Emile63
Le Tuesday, September 14, 2021 Í  9:02:24 PM UTC+2, MichD a écrit :
Le 14/09/21 Í  11:46, Emile63 a écrit :
Le Monday, September 13, 2021 Í  7:53:16 PM UTC+2, MichD a écrit :
Le 13/09/21 Í  12:40, MichD a écrit :
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image
demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.LockAspectRatio = msoTrue
.Shape.Width = 103 * L / 4
End With
End With
Else
MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD
En fait, le résultat est vrai, si ton moniteur Í  24" et qu'il est en HD
1920 X1080.
Selon la grandeur d'écran, le mode d'affichage (1920 X 1080), le nombre
de points Í  l'écran du moniteur varie. Dans mon environnement, l'image a
vraiment le nombre de CM désiré que tu peux mesurer avec une règle.
Regarde Í  cette adresse, tu verras différentes manières d'effectuer des
conversions dans Excel, de centimètres en points, de pouces en points,
points en pixels.
La valeur 108.78 est estimée et ne provient pas de la fonction :
x=application.CentimetersToPoints(B), B étant le nombre de CM
https://exceloffthegrid.com/vba-convert-centimeters-inches-pixels-to-points/
Pour obtenir un vrai 5 CM Í  l'écran (que tu peux mesurer avec une règle)
compte tenu des différentes variables énoncées, la donne est un peu plus
complexe que celle énoncée ici.
La solution énoncée ici ne convient pas Í  tous les environnements.
MichD
----------------------------------
Bonjour MichD,
J'ai toujours le problème d'une image non proportionnelle, je t'ai mis un exemple en document joint.
https://www.cjoint.com/c/KIopKcx14kk
Le cadre de l'image mesure bien la taille donnée (5 cm par ex.), mais l'image en question en souffre :(
Est-ce qu'avec du code on arrive Í  géré la boÍ®te de message figurant sur le fichier ci-joint?
Par ailleurs, c'est entre 5 et 15 cm de largeur que je souhaiterais visualiser...
J'avoue ne pas (encore) avoir été au lien que tu me suggères (manque de temps aujourd'hui),
mais ton commentaire : x=application.CentimetersToPoints(B)
me paraÍ®t pile poil ce que je cherche Í  utiliser pour autant que soit résolue cette satanée proportionnalité de l'image :-)
Merci encore pour tes suggestion, et très bonne fin de journée.
Emile
La procédure est basée sur la largeur du commentaire.
Cependant, tu devrais avoir des images proportionnées
aux originaux.
Une dernière version :
fichier joint : https://www.cjoint.com/c/KIos6T2m6sF
'---------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim A As Double, B As Double, C As Double, L As Double
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un
commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et
8 centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
'Insérer un fichier image dans Excel
Set Sh = Feuil2.Shapes.AddPicture(Fichier, False, True,
Range("B2").Left, Range("B2").Top, -1, -1)
A = Sh.Width
B = Application.CentimetersToPoints(L)
If A > B Then
C = B / A
Sh.ScaleWidth C, msoFalse, msoScaleFromTopLeft
Else
C = B / A
Sh.ScaleHeight C, msoFalse, msoScaleFromTopLeft
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.Width = Sh.Width
.Shape.Height = Sh.Height
Sh.Delete
End With
End With
Else
MsgBox "Aucune image a été retenue.", _
vbInformation + vbOKCancel, "Opération annulée."
End If
End Sub
'---------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------
MichD

Bonjour MichD,
Merci pour cette procédure et feuille avec le l'insertion.
La ligne que tu as créee dans cette dernière mouture:
' Set Sh = Feuil2.Shapes.AddPicture(Fichier, False, True, Range("B2").Left, Range("B2").Top, -1, -1)
Cherche la cellule B2 de la feuil2, mon problème c'est que je souhaite insérer l'image dans n'importe quelle feuille de n'importe quel classeur.
Je n'ai pas (encore) tester mais est-ce que je suis dans le vrai avec ça ?
Activesheet.Shapes.AddPicture(Fichier, False, True, Range(Activecell).Left, Range(Activecell).Top, -1, -1)
Avatar
MichD
Le 15/09/21 Í  05:56, Emile63 a écrit :
Le Tuesday, September 14, 2021 Í  9:02:24 PM UTC+2, MichD a écrit :
Le 14/09/21 Í  11:46, Emile63 a écrit :
Le Monday, September 13, 2021 Í  7:53:16 PM UTC+2, MichD a écrit :
Le 13/09/21 Í  12:40, MichD a écrit :
Le 13/09/21 Í  10:30, MichD a écrit :
Essaie comme ceci :
J'ai fixé les bornes de la largeur de l'image entre
3 et 8 cm. Tu peux les modifier Í  volonté.
Si tu prends une règle, tu devrais obtenir la largeur de l'image
demandée.
'------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim T As Double, X As Double, L As Variant
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et 8
centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.LockAspectRatio = msoTrue
.Shape.Width = 103 * L / 4
End With
End With
Else
MsgBox "Aucune image a été retenue."
End If
End Sub
'------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'-------------------------------------------
MichD

Dans la procédure "Sub Insérer_Image_ActiveCell()" remplace
.Shape.Width = 108.78 * L / 4
Par
.Shape.Width = 108.78 * L / 4
MichD

En fait, le résultat est vrai, si ton moniteur Í  24" et qu'il est en HD
1920 X1080.
Selon la grandeur d'écran, le mode d'affichage (1920 X 1080), le nombre
de points Í  l'écran du moniteur varie. Dans mon environnement, l'image a
vraiment le nombre de CM désiré que tu peux mesurer avec une règle.
Regarde Í  cette adresse, tu verras différentes manières d'effectuer des
conversions dans Excel, de centimètres en points, de pouces en points,
points en pixels.
La valeur 108.78 est estimée et ne provient pas de la fonction :
x=application.CentimetersToPoints(B), B étant le nombre de CM
https://exceloffthegrid.com/vba-convert-centimeters-inches-pixels-to-points/
Pour obtenir un vrai 5 CM Í  l'écran (que tu peux mesurer avec une règle)
compte tenu des différentes variables énoncées, la donne est un peu plus
complexe que celle énoncée ici.
La solution énoncée ici ne convient pas Í  tous les environnements.
MichD

----------------------------------
Bonjour MichD,
J'ai toujours le problème d'une image non proportionnelle, je t'ai mis un exemple en document joint.
https://www.cjoint.com/c/KIopKcx14kk
Le cadre de l'image mesure bien la taille donnée (5 cm par ex.), mais l'image en question en souffre :(
Est-ce qu'avec du code on arrive Í  géré la boÍ®te de message figurant sur le fichier ci-joint?
Par ailleurs, c'est entre 5 et 15 cm de largeur que je souhaiterais visualiser...
J'avoue ne pas (encore) avoir été au lien que tu me suggères (manque de temps aujourd'hui),
mais ton commentaire : x=application.CentimetersToPoints(B)
me paraÍ®t pile poil ce que je cherche Í  utiliser pour autant que soit résolue cette satanée proportionnalité de l'image :-)
Merci encore pour tes suggestion, et très bonne fin de journée.
Emile

La procédure est basée sur la largeur du commentaire.
Cependant, tu devrais avoir des images proportionnées
aux originaux.
Une dernière version :
fichier joint : https://www.cjoint.com/c/KIos6T2m6sF
'---------------------------------------------
Sub Insérer_Image_ActiveCell()
Dim CheminEtTypeFichier As String, Fichier As String
Dim A As Double, B As Double, C As Double, L As Double
'Chemin du répertoire contenant les images
CheminEtTypeFichier = "F:OneDriveImagesPellicule*.*"
Fichier = BrowseFile(CheminEtTypeFichier)
If Fichier <> "" Then
L = CDbl(InputBox("Vous allez insérer une image dans un
commentaire." & _
vbCrLf & "Quelle doit être la largeur de cette image en " & _
vbCrLf & "centimètre. Saisissez la largeur désirée, entre 3 et
8 centimètres." & _
"Exemple : 4 ou 5 ou 4.5, etc.", "Largeur de l'image", "5"))
'Détermine les bornes de l'image entre 3 et 8cm
'Í  toi de choisir les bornes désirées
If L < 3 Or L > 8 Then
MsgBox "La valeur saisie pour la largeur de l'image " & _
"est en dehors des bornes permises, entre 3 et 8. " & _
"Exécuter Í  nouveau la procédure. ", vbCritical + vbOKOnly, _
"Largeur de l'image non permise"
Exit Sub
End If
'Insérer un fichier image dans Excel
Set Sh = Feuil2.Shapes.AddPicture(Fichier, False, True,
Range("B2").Left, Range("B2").Top, -1, -1)
A = Sh.Width
B = Application.CentimetersToPoints(L)
If A > B Then
C = B / A
Sh.ScaleWidth C, msoFalse, msoScaleFromTopLeft
Else
C = B / A
Sh.ScaleHeight C, msoFalse, msoScaleFromTopLeft
End If
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier
.Shape.Width = Sh.Width
.Shape.Height = Sh.Height
Sh.Delete
End With
End With
Else
MsgBox "Aucune image a été retenue.", _
vbInformation + vbOKCancel, "Opération annulée."
End If
End Sub
'---------------------------------------------
Function BrowseFile(CheminEtTypeFichier) As String
With Application.FileDialog(msoFileDialogFilePicker)
'Définit un titre pour la boÍ®te de dialogue
.Title = "Choisir le fichier image de ton choix"
'Empêcher la multisélection
.AllowMultiSelect = False
'Répertoire par défaut suivi du type de fichier par défaut
.InitialFileName = CheminEtTypeFichier
'Efface les filtres existants.
.Filters.Clear
'Définis une liste de filtres pour le champ "Type de fichiers".
'tu peux ajouter toutes les extensions que tu as besoin
.Filters.Add "Images", "*.png; *.jpg; *.bmp"
'Définit le filtre qui s'affiche par
'défaut dans le champ "Type de fichiers "."
.FilterIndex = 1
'Indique le type d'affichage dans la boͮte de dialogue
'(exemple visualisation des propriétés)
.InitialView = msoFileDialogViewProperties
'Affiche la boͮte de dialogue
.Show
If .SelectedItems.Count > 0 Then
BrowseFile = .SelectedItems(1)
Else
BrowseFile = ""
End If
End With
End Function
'---------------------------------------------
MichD

Bonjour MichD,
Merci pour cette procédure et feuille avec le l'insertion.
La ligne que tu as créee dans cette dernière mouture:
' Set Sh = Feuil2.Shapes.AddPicture(Fichier, False, True, Range("B2").Left, Range("B2").Top, -1, -1)
Cherche la cellule B2 de la feuil2, mon problème c'est que je souhaite insérer l'image dans n'importe quelle feuille de n'importe quel classeur.
Je n'ai pas (encore) tester mais est-ce que je suis dans le vrai avec ça ?
Activesheet.Shapes.AddPicture(Fichier, False, True, Range(Activecell).Left, Range(Activecell).Top, -1, -1)

Remplace Feuil2 par activesheet c'est OK.
Le code que je donne, ce n'est qu'un exemple. Il ne faut pas te gêner
pour effectuer quelques modifications selon ton environnement.
MichD
Avatar
Emile63
Remplace Feuil2 par activesheet c'est OK.
Le code que je donne, ce n'est qu'un exemple. Il ne faut pas te gêner
pour effectuer quelques modifications selon ton environnement.
MichD

Re-Bonjour MichD,
Merci pour ton aide et ta patience, certainement Í  bout touchant, mais je n'y arrive pas...
J'ai passé la procédure dans ma feuil PERSONAL.XLSB , pour l'avoir constamment sous la main.
et autant sur l'exemple que tu m'as joint, ça fonctionne, autant depuis n'importe quel endroit de n'importe quelle feuil, je me retrouve avec le même problème de proportions.
J'ai cherché si je trouvais la différence entre l'une et l'autre mais je ne vois pas..
A partir d'ici;
'Tu insert un fichier image dans Excel, OK
Set Sh = ActiveSheet.Shapes.AddPicture(Fichier, False, True, ActiveCell.Left, ActiveCell.Top, -1, -1)
A = Sh.Width
B = Application.CentimetersToPoints(L)
' Tu cherches a connaitre le rapport larg. x hauteur, Ok
If A > B Then
C = B / A
Sh.ScaleWidth C, msoFalse, msoScaleFromTopLeft
Else
C = B / A
Sh.ScaleHeight C, msoFalse, msoScaleFromTopLeft
End If
' Mais la fin de la proc reste inchangée, Í  sers l'étape préalable de l'image dans la feuille ?
' tu inserts l'image avec les variables A & B du début et donc je ne vois pas Í  quoi sert la variable C que tu as calculé
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier ' Ici ne devrais tu pas insérer l'image qui est sur la feuille ?
.Shape.Width = A ' ici ce sont les largeur et hauteurs originales te donc ne tien spas compte du rapport de l'image
.Shape.Height = B
Sh.Delete
End With
End With
Avatar
MichD
Le 15/09/21 Í  07:47, Emile63 a écrit :

Remplace Feuil2 par activesheet c'est OK.
Le code que je donne, ce n'est qu'un exemple. Il ne faut pas te gêner
pour effectuer quelques modifications selon ton environnement.
MichD

Re-Bonjour MichD,
Merci pour ton aide et ta patience, certainement Í  bout touchant, mais je n'y arrive pas...
J'ai passé la procédure dans ma feuil PERSONAL.XLSB , pour l'avoir constamment sous la main.
et autant sur l'exemple que tu m'as joint, ça fonctionne, autant depuis n'importe quel endroit de n'importe quelle feuil, je me retrouve avec le même problème de proportions.
J'ai cherché si je trouvais la différence entre l'une et l'autre mais je ne vois pas..
A partir d'ici;
'Tu insert un fichier image dans Excel, OK
Set Sh = ActiveSheet.Shapes.AddPicture(Fichier, False, True, ActiveCell.Left, ActiveCell.Top, -1, -1)
A = Sh.Width
B = Application.CentimetersToPoints(L)
' Tu cherches a connaitre le rapport larg. x hauteur, Ok
If A > B Then
C = B / A
Sh.ScaleWidth C, msoFalse, msoScaleFromTopLeft
Else
C = B / A
Sh.ScaleHeight C, msoFalse, msoScaleFromTopLeft
End If
' Mais la fin de la proc reste inchangée, Í  sers l'étape préalable de l'image dans la feuille ?
' tu inserts l'image avec les variables A & B du début et donc je ne vois pas Í  quoi sert la variable C que tu as calculé
With ActiveCell
.ClearComments
.AddComment
With .Comment
.Visible = True 'or false
.Text Text:=""
.Shape.Fill.UserPicture Fichier ' Ici ne devrais tu pas insérer l'image qui est sur la feuille ?
.Shape.Width = A ' ici ce sont les largeur et hauteurs originales te donc ne tien spas compte du rapport de l'image
.Shape.Height = B
Sh.Delete
End With
End With

Chaque fois que tu ajoutes un commentaire, la dimension de celui-ci est
standard. L'image s'adapte au commentaire.
En insérant l'image dans la feuille de calcul, il est possible de
déterminer la dimension de l'image.
Immédiatement après l'insertion de l'image dans la feuille, j'obtiens
avec cette ligne de code, la largeur originale de l'image
A = Sh.Width
L'Image est par la suite redimensionnée selon la largeur choisit pas
l'usager.
Dans le commentaire, l'image n'est pas aux dimensions originales, mais
aux nouvelles dimensions de celle-ci. L'image insérée dans la feuille
est supprimée. Chez moi, cela fonctionne très bien.
Tu peux exécuter la procédure pas Í  pas en utilisant la touche F8 et
observer la transformation de l'image originale...
Dans un fichier zip, insère quelques images qui te posent problème.
Ce n'est pas sͻr que je peux regarder cela aujourd'hui...
MichD
Avatar
Emile63
Le Wednesday, September 15, 2021 Í  2:27:01 PM UTC+2, MichD a écrit :
Le 15/09/21 Í  07:47, Emile63 a écrit :

Chaque fois que tu ajoutes un commentaire, la dimension de celui-ci est
standard. L'image s'adapte au commentaire.
En insérant l'image dans la feuille de calcul, il est possible de
déterminer la dimension de l'image.
Immédiatement après l'insertion de l'image dans la feuille, j'obtiens
avec cette ligne de code, la largeur originale de l'image
A = Sh.Width
L'Image est par la suite redimensionnée selon la largeur choisit pas
l'usager.
Dans le commentaire, l'image n'est pas aux dimensions originales, mais
aux nouvelles dimensions de celle-ci. L'image insérée dans la feuille
est supprimée. Chez moi, cela fonctionne très bien.
Tu peux exécuter la procédure pas Í  pas en utilisant la touche F8 et
observer la transformation de l'image originale...
Dans un fichier zip, insère quelques images qui te posent problème.
Ce n'est pas sͻr que je peux regarder cela aujourd'hui...
MichD

Ok, prends ton temps.
Merci pour ta disponibilité, et bonne fin de journée.
https://www.cjoint.com/c/KIpnB1wcFtk
1 2 3