Microsoft 365 userform avec contrôle image

[JULLIEN Philippe]

Bonjour le forum,
Voilà, je suis autodidacte en VBA Excel. Je fais des petits truc sur Excel pour passer le temps à la retraite. Il y a quelque temps j'avais mis une photo dans un contrôle image d'userform mais j'ai oublié dans quel classeur.
J'aimerais savoir si il est possible par une macro de comptabiliser les userform d'un autre classeur et plus savoir si un userform contient une image *.jpg. J'ai cherché sur internet mais en vain.
Merci pour votre aide

 

[vgendron]

Bonjour

peut etre des éléments de réponse ici

Visual Basic Editor

Visual Basic Editor

silkyroad.developpez.com

 

[Dranreb]

Bonjour.
Il n'est gardé aucune trace de la référence du fichier source d'une image d'UserForm.

 

[sylvanu]

Bonjour Julien, Vgendron,
Peut être un essai en PJ. ( pas trouvé mieux )
Le chemin du dossier à analyser est à mettre en B1, il doit se terminer par "\".
Il fait la liste des fichier contenant un userform. ( avec ou sans image 😉 )
Le nom des fichiers analysés sont dans le statusbar car c'est assez long.

 

[job75]

Bonjour à tous,

Il n'est gardé aucune trace de la référence du fichier source d'une image d'UserForm.

Oui mais on peut rechercher les fichiers qui contiennent des UserForms et chercher si ceux-ci contiennent des images :

Sub RechercheImage()
Dim chemin$, lig&, fichier$, wb As Workbook, vbc As Object, ctrl As Object
chemin = ThisWorkbook.Path & "\" 'dossier de la recherche
fichier = Dir(chemin & "*.xlsm")
Application.ScreenUpdating = False
With ActiveSheet.[A1].CurrentRegion
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(chemin & fichier) 'ouverture du fichier
            For Each vbc In wb.VBProject.VBComponents
                If vbc.Type = 3 Then 'UserForm
                    .Cells(lig, 1) = fichier
                    .Cells(lig, 2) = vbc.Name
                    For Each ctrl In vbc.Designer.Controls
                        If TypeName(ctrl) = "Image" Then .Cells(lig, 3) = "Oui": Exit For
                    Next ctrl
                    lig = lig + 1
                End If
            Next vbc
            wb.Close False 'fermeture du fichier
        End If
        fichier = Dir 'fichier suivant
    Wend
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

A+

 

[job75]

Je précise que pour pouvoir lire ou modifier le VBAProject il faut avoir coché l'option Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

Ceci sur Excel 2007 et versions suivantes, je suppose que c'est pareil sur MS 365.

 

[patricktoulon]

bonjour @job75
on a eu la même idée
je vais un peu plus loin je sauve les images dans un dossier

Sub test()
    Dim uF As Object, WbK As Workbook, vbcomp, CtrL, chemin
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set WbK = Workbooks.Open("C:\Users\patricktoulon\Desktop\classeuruserform.xlsm")
    chemin = ThisWorkbook.Path & "\images de " & WbK.Name & "_All)"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
    For Each vbcomp In WbK.VBProject.vbcomponents
        If vbcomp.Type = 3 Then
            Set uF = vbcomp
            On Error Resume Next
            SavePicture uF.Designer.Picture, ThisWorkbook.Path & "\" & WbK.Name & uF.Name & ".jpg"
            On Error GoTo 0
            For Each CtrL In uF.Designer.Controls
                If TypeName(CtrL) = "Image" Then
                    On Error Resume Next
                    SavePicture CtrL.Picture, chemin & "\" & WbK.Name & "_" & uF.Name & "_" & CtrL.Name & ".jpg"
                    On Error GoTo 0
                End If
            Next
        End If
    Next
WbK.Close
End Sub

il faudra passer les images a la moulinette wia ou autre pour reduire leur poids
car on le sait le le stdpicture contient un bitmap et savepicture utilise un stdpicture
dans mes tests j'ai mis une image de 76 kilos dans un control image
et après l'avoir récupérer avec savepicture elle fait 4.11 Mega
je vous fait la moulinette WIA si vous voulez

 

[patricktoulon]

@job75
et afin de ne récupérer que les controls image qui ont une image jpg valide
on teste le transfert dans un ipictureDisp
si ça passe le bitmap est valable il est donc sauvable en jpg

Dim pict As IPictureDisp
            For Each CtrL In vbc.Designer.Controls
                If TypeName(CtrL) = "Image" Then
                    On Error Resume Next
                    pict.Picture = CtrL.Picture
                    If Not Err Then .Cells(lig, 3) = "Oui": Exit For
                    On Error GoTo 0
                End If
            Next

patrick

 

[JULLIEN Philippe]

Je précise que pour pouvoir lire ou modifier le VBAProject il faut avoir coché l'option Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

Ceci sur Excel 2007 et versions suivantes, je suppose que c'est pareil sur MS 365.

je vous remercie tous pour ces réponses, qui me sont bien compliquées à assimiler (je suis septuagénaire et je commence à avoir du mal...)
J'attends mon fils qui va peut-être m'aider à faire ce que je veux. En attendant je note tous ces codes.
Merci encore.

 

[JULLIEN Philippe]

je vous remercie tous pour ces réponses, qui me sont bien compliquées à assimiler (je suis septuagénaire et je commence à avoir du mal...)
J'attends mon fils qui va peut-être m'aider à faire ce que je veux. En attendant je note tous ces codes.
Merci encore.
PS
j'essaie de me dépatouiller seul, j'ai bien coché l'option Accès approuvé... mais quand je lance ma macro une erreur se produit à la ligne
« For Each CtrL In vbc.Designer.Controls » comment sont déclarées les variables
À partir des classeurs (simplifiés) Esf.xlsm et Esf4.xlsm, je voudrais que classeur Esf4 actif que la macro "Reponse" affiche "Oui" pour la présence du contrôle image dans l'userform. Jee rappelle que je bidouille en VBA uniquement pour garder mon esprit actif vu mon âge.
certains de mes classeurs me sont utiles d'autres non mais ça me force à réfléchir, raisonner.

 

[patricktoulon]

bonjour
essaie plutôt celui là

 

[JULLIEN Philippe]

bonjour
essaie plutôt celui là

RE-Bonjour
À priori ça marche, il me reste plus qu'à adapter le code à mon classeur. Il faut apprendre quelque chose tous les jours pour éviter de vieillir.
Un grand merci.
Philippe

 

[JULLIEN Philippe]

Bonsoir,
J'ai adapté le code à mes besoins le résultat m'est très satisfaisant, Parfait.
encore un grand merci.