En VBA: fichier image en paysage ou en portrait ?

Bonjour,

J’ai besoin d’aide sur un truc particulier en VBA.

Comment savoir (en VBA) si une image (par ex. fichier.jpg) est en mode portrait ou paysage ?

(ceci pour pouvoir adapter l’emplacement dans un UserForm.)

Merci à ceux qui savent

Jean-Pierre.

Bonsoir,

Tu compares la hauteur et la largeur ! (propriétés Height et Width)

Cordialement.

Merci pour cette réponse très rapide.

Mais je viens de commencer le VBA et je ne sais pas comment obtenir le Height et Width d'un fichier image

Admettons que j'ai dans une variable string contenant mon fichier (Var_String = "C:\avion.jpg")

Comment j'obtient le largeur et la hauteur ?

Merci pour le code mais cela sera pour demain, maintenant c'est dodo

Jean-Pierre

Comment se présente ton code actuel ?

Je n'ai pas de code à proposer car je n'ai aucune idée qu'elle fonction utiliser pour obtenir cette caractéristique du fichier image.

C'est pourquoi je suis venu sur ce forum

Merci pour une solution

Jean-Pierre

Tu parles de charger une image (post initial). Ce n'est pas avant de la charger qu'on fait des ajustement, c'est après. Ce pourquoi je demande ton code chargeant l'image puisque c'est lui qu'il faudra compléter...

Je crois que je me suis mal exprimé.

Je veux afficher dans un formulaire (userform) une photo (qui s'appel "Base1.jpg") dont je vais chercher le chemin dans une cellule de "Feuil1".

Le chemin et le nom du fichier se trouve dans la variable "Photo"

Pour afficher l'image j'utilise le code suivant:

         Dim Photo, txt As String

         Photo = Dossier_Photos & Ws.Cells(BD_Ligne, BD_Colonne_Photo) ' Création du chemin de la photo

        ' test si la photo "Base1.jpg" existe à cet emplacement et met le nom en minuscule
         txt = Dir(Photo)          ' La fonction dir me retourne "Base1.jpg" si le fichier existe
         txt = LCase(txt)            ' converti toute la chaine de caractères en minuscule
         If txt = "base1.jpg" Then           ' test si le fichier Base1.jpg" existe. 
' C'est ici ou j'aimerai faire un test pour savoir si mon image est en paysage ou en portrait pour la charger soit en "image 1" ou en "image 2".     
             Me.Image1.Picture = LoadPicture(Photo)  'si la photo existe, elle est chargée 
        Else
             Me.Image1.Picture = LoadPicture("")  'Sinon, l'on efface l'image présente.
        End If
 

Donc comment tester que "Photo" est en mode paysage ou portrait ?

Merci pour le coup de main

Bonsoir,

J'ai étudié ton problème (qui m'intéressait aussi par ailleurs, et qui peut intéresser pas mal de monde...) et élargi un peu les recherches que j'avais déjà pu faire sur le sujet. Outre des bidouillages toujours possible mais que si l'on peut éviter... il y a quelques méthodes... mais la simplicité d'utilisation (n'exige pas l'ajout de références, voire de bibliothèques qui peuvent être absentes) m'a fait revenir aux références de Boisgontier en la matière ( ) qui utilise l'objet Shell.Application.

En gros ça consiste à aller chercher une propriété de fichier sous Windows qui fournit les dimensions de l'image en pixels. J'aurais pu gagner du temps (car je commence presque toujours mes recherches par Boisgontier), cependant mes investigations colatérales n'ont pas été inutiles car elles m'ont soulevé quelques écueils que j'ai dû effectivement surmonter.

En particulier, le code de Boisgontier s'applique à Win XP mais sur les versions ultérieures de Windows, la propriété n'a plus le même index et ne se présente plus sous la même forme. Il te faudra d'ailleurs tester si elle fonctionne sous ta version de Windows (ou s'il faut repartir à la pêche pour trouver les éléments d'adaptation...)

J'ai traduit cette recherche, par une fonction fournissant un ratio de l'image : le rapport largeur/hauteur sous forme numérique.

Si le rapport est inférieur à 1, l'image est en orientation portrait, s'il est supérieur à 1, elle est en orientation paysage (et si le rapport est égal à 1, elle est carrée).

Le rapport pourra de plus être utilisé pour des redimensionnements (conservant le ratio image).

La fonction :

Function RatioImg(ByVal chDos, ByVal Fimg) As Single
    Dim shApp As Object, fld As Object, Fich As Object, hw
    Set shApp = CreateObject("Shell.Application")
    Set fld = shApp.Namespace(chDos)
    Set Fich = fld.items.Item(Fimg)
    hw = fld.getdetailsof(Fich, 31)
    hw = Split(Mid(hw, 2, Len(hw) - 2), "x")
    RatioImg = Val(hw(0)) / Val(hw(1))
End Function

Pour la tester, tu affectes le résultat qu'elle renvoie à une variable...

rapportimage = RatioImg(cheminDossierImage, nomFichierImage)

dont tu pourras ensuite visualiser le contenu (pour t'assurer de la nature du résultat), tester s'il est < ou > à 1...

Quelques points à savoir pour utiliser cette fonction :

• le premier argument de la fonction est le chemin du dossier contenant l'image. Exemple : "C:\MesDocuments" ou "E:\DossierPhoto"... C'est le chemin complet du Dossier qui doit être fourni, mais sans séparateur ("\") final.
• le second argument est le nom du fichier. Exemple : "MonImage.jpg"...

- A noter que les arguments sont passés par valeurs à la fonction. Pour être correctement traitées les valeurs passées doivent être de type Variant, or on a souvent des variables String pour le chemin et le nom d'un fichier... Sans cela on aurait eu soit un résultat "vide", soit une erreur (j'ai eu les 2 ! je n'ai pas pu déterminer ce qui les différenciait, bien qu'il me semble que l'erreur intervenait sur des essais en Sub et l'absence de réponse sur des essais par appel de fonction...) En tout cas, le type d'erreur sur un objet "interne" à VBA ou Excel aurait été "ByRef incompatible...", ce qui aurait mis le doigt sur le problème, alors que là elle renvoie l'erreur 91 en cas d'erreur (Tu aurais pu chercher longtemps... )

- impossible aussi de manipuler la chaîne renvoyée par la propriété avec Replace, d'où l'utilisation de Mid qui heureusement a fonctionné (elle se présente sous la forme "?240 x 360?" : largeur en pixels[expace]x[espace]hauteur en pixels, encadrée par des ?)

- le code d'index de la propriété est 31 (qui apparaît dans la ligne de commande d'extraction de la propriété). C'était 26 sous XP (et la chaîne se présentait sans ?). Celui-ci est valide sous Win 7, mais je ne peux garantir qu'il est demeuré inchangé sous les versions ultérieures. C'est donc à tester... Le cas échéant, on finira bien par trouver le bon code !

Cordialement.

Merci pour ces recherches et cette réponse détaillée.

J'ai testé avec 31 mais la variable "hw" me retourne le texte "dimension" mais pas la valeur de la dimension.

J'ai testé d'autres valeurs que 31 mais cela retourne du texte style "auteur" ou "appareil photo" mais pas les réponses attendues

Je suis sous Windows 10.

hw = fld.getdetailsof(Fich, 31)

Ou ai-je fait une erreur ou est ce Windows 10

Je te met le code que j'ai testé

Function RatioImg(ByVal chDos, ByVal Fimg) As Single

    Dim shApp As Object, fld As Object, Fich As Object, hw
    Dim i, imax As Integer

    imax = 35
    Set shApp = CreateObject("Shell.Application")
    Set fld = shApp.Namespace(chDos)
    Set Fich = fld.items.Item(Fimg)
    For i = 30 To imax
       hw = fld.getdetailsof(Fich, i)
       If MsgBox(i & "    " & hw & "    Confirmez-vous l'insertion de ce nouveau contact ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
              i = imax
       End If
    Next i
    hw = Split(Mid(hw, 2, Len(hw) - 2), "x")
    RatioImg = Val(hw(0)) / Val(hw(1))

End Function 

Par contre ce qui me gêne particulièrement c'est que cette solution dépend du système d'exploitation.

As-tu une idée ?

En tout cas un grand merci pour tes recherches et ton aide

Bonsoir,

Je trouve curieux que cela te retourne "dimension"...

Il y 2 aspects : l'index de la propriété, qui n'est peut-être pas 31 sous Win10 (mais qui l'est peut-être, la propriété étant formulée autrement)

le texte de la propriété contenant les dimensions, qu'il faut ensuite traiter pour les en extraire.

J'ai réaménagé la fonction en Sub pour lui faire lister les propriétés, de façon qu'on identifie la bonne et sous quelle forme on la récupère.

Sub RechProprImg(ByVal chDos, ByVal Fimg)
    Dim shApp As Object, fld As Object, Fich As Object, hw, i%, msg$
    Set shApp = CreateObject("Shell.Application")
    Set fld = shApp.Namespace(chDos)
    Set Fich = fld.items.Item(Fimg)
    On Error GoTo noP
    For i = 0 To 40
        hw = fld.getdetailsof(Fich, i)
        msg = msg & i & "- " & hw & Chr(10)
noP:
    Next i
    MsgBox msg
End Sub

Sub TestRech()
    Dim chemin, fichier
    chemin = 'Indiquer le chemin de l'image
    fichier = 'Indiquer le nom du fichier image
    RechProprImg chemin, fichier
End Sub

Il faut compléter la macro Test par les chemins et noms de fichiers, et tu devrais avoir la liste de toutes les propriétés (si 40 ne suffit pas, tu peux augmenter ! )

Cordialement.

J'ai fait le test et voici le résultat:

On a réussi à lister les informations disponibles mais pas leur contenu

de 41 à 80 c'est du même style

Autres idées ?

Ça m'épate ! Pas d'autre idée pour l'instant. Je réfléchis...

Un "bidouillage" en attendant d'éclaircir ce problème...

Function RapImg(chFichImg As String)
    Dim img As Picture, w!, h!
    Application.ScreenUpdating = False
    Set img = ActiveSheet.Pictures.Insert(chFichImg)
    w = img.Width: h = img.Height: img.Delete
    RapImg = w / h
End Function

Sub Test()
    Dim ChDos$, Fimg$
    ChDos = 'Indiquer chemin du dossier
    Fimg = 'Indiquer nom fichier image
    MsgBox RapImg(ChDos & "\" & Fimg)
End Sub

Cordialement.

Il y a un problème avec le "bidouillage"

J'obtiens l'erreur "impossible de lire la propriété Insert de la classe Pictures" à la ligne

" Set img = ActiveSheet.Pictures.Insert(chFichImg)"

Et mes capacités VBA son telles que je ne sais pas résoudre cela

Donc encore une fois "Merci pour le coup de main"

Ahah ! Un problème similaire se pose sur un autre sujet avec une commande similaire :

Pictures.Paste au lieu de Pictures.Insert, mais la structure est la même, et c'est aussi sur 2013 !

La commande en elle-même est correcte. Je me suis même fendu d'un enregistrement ( ) qui me produit la même commande !!

Mais on ne peut lui accorder crédit car en enregistrant avec l'outil appareil photo (qui est équivalent) il produit autre chose et qui plante systématiquement à l'exécution.

J'aurais tendance à supposer que 2013 ne supporte pas l'affectation simultanée à une variable objet. Je vais donc essayer de tourner ça autrement...

Merci pour ces infos.

Je me rend compte que tout cela dépend beaucoup de la version excel et de la version Windows.

D'autre part je remarque que toutes les images que je veux afficher me sont connues .

Je pourrais donc, pour m'affranchir des version Excel et/ou Windows, renommer les noms de mes images pour savoir si elles sont en paysage ou en portrait.

Par exemple .

Image1.jpg deviendrait "Image1_Por.jpg" ou "Image1_Pay.jpg"

J'en conviens, cela n'est pas très élégant mais cela m'affranchi des variations des systèmes.

Cela est possible pour moi mais cela ne résout pas le problème général avec des images inconnues ou aléatoires.

Je vais choisir la solution de simplicité et renommer mes images plutôt que de me retrouver embêté d'ici quelques temps suite à une modification de Excel ou Windows.

En tout cas un grand merci pour toute cette aide.

Ce forum que je découvre est génial.

Vu mes connaissances, je suis sur de revenir à la charge avec d'autres questions

Merci et bon dimanche à la Réunion

Jean-Pierre

L'erreur 1004 n'est pas une erreur VBA, c'est une erreur Excel, ce qui rend les recherches plus difficiles, car selon contexte l'erreur peut ou pas se produire. Il y en a qui sont illogiques (c'est le type de celle-ci), mais quand elles se produisent sur toutes les versions (comme l'affectation à une variable objet d'une feuille copiée) on code en conséquence sans attendre !

Le problème similaire s'étant réglé de la façon à laquelle j'avais pensé, je te fais l'adaptation correspondante de la fonction :

Function RapImg(chFichImg As String)
    Dim img As Object, w!, h!
    Application.ScreenUpdating = False
    ActiveSheet.Pictures.Insert(chFichImg).Select
    Set img = Selection
    w = img.Width: h = img.Height: img.Delete
    RapImg = w / h
End Function

NB- N'oublie pas le cas échéant que dans un module, on place en tête les déclarations (s'il y en a), ensuite les procédures Function, et enfin les procédures Sub...

Cordialement.

Ok cela fonctionne parfaitement.

Un grand merci pour ton aide

Encore une question:

Est ce que cela marchera toujours en principe avec Windows 11 ou 12 et avec excel 2016 ou 18 ?

Je sais bien q'il est difficile de répondre à cette question mais si l'on tourne la question autrement:

Est ce que ce code marche avec Windows XP, Windows 7 et/ou 8.

De même avec Excel 2003 par exemple.

Comme je ne veux pas retoucher ce code dans le futur je me demande s'il ne vaut pas mieux que je renomme mes images pour avoir la paix pour le futur.

Merci pour ton avis

Là on n'entre pas en relation avec le système, c'est donc totalement indépendant de la version de Windows.

En ce qui concerne Excel, difficile de s'engager sur les versions à venir, mais cela devrait a-priori fonctionner sur toutes les versions existantes, au moins depuis Excel 2000. Vu la nature du problème qui est que certaines versions (ou éventuellement selon contexte) acceptent mal que l'on prenne un raccourci en affectant dans la même ligne de code un objet généré à une variable, les versions qui l'acceptent, acceptent aussi évidemment qu'on dissocie l'affectation et qu'on écrive deux lignes au lieu d'une... Pas de problème à craindre avec 2003 donc.

Cordialement.

OK, encore un grand merci pour ton aide

Bonne semaine