XL 2016 AIDE Useform Image

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Maathis
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Maathis

Maathis

XLDnaute Nouveau
Bonjour à tous,

Je reviens vers vous, toujours avec le formulaire de saisie mais maintenant sous la forme d'un useform.
J'aimerais que avant d'enregistrer les infos dans la base, tous les champs soit complété et l'image inséré.

VB: 
If Len(Me.txtL) = 0 Then
        Me.message = "Veuillez saisir ***"
        Me.txtL.SetFocus
    ElseIf Len(Me.txtC) = 0 Then
        Me.message = "Veuillez saisir ***"
        Me.txtC.SetFocus
    ElseIf Len(Me.cbA) = 0 Then
        Me.message = "Veuillez saisir ***"
        Me.cbA.SetFocus
    ElseIf Len(Me.cbM) = 0 Then
        Me.message = "Veuillez saisir ***"
        Me.cbM.SetFocus

    End If

J'ai déjà réussi à tester si les champs était vide ou non mais je bloque sur la présence de l'image ou pas.

Pouvez vous m'aidez à trouver le code pour savoir si une image est présente dans la zone image activeX ou non ?

Ci-joint mon userform:
aide.PNG


Merci d'avance 🙂
 
Solution
fanch55
VB: 
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
             
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
                    TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                    SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
   
                ' Injection du fichier temporaire dans une form Image de la feuille
                 ActiveCell.Offset(0, 4).Select
                 With...
Trier par date Trier par votes
Une autre approche dans le classeur joint :
les images sont enregistrées dans une colonne d'un tableau structurée .

Elles sont plus petites que la cellule d'accueil pour pouvoir être détruites en même temps que la ligne du tableau.

A ce propos, pour tous les gourous de ce forum, je me heurte à un phénomène énervant:
l'image de la première ligne du tableau n'est jamais détruite sinon manuellement...
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour à tous

Width:=-1, Height:=-1 -> cela signifie que l'image conserve sa taille d'origine

J'ai changé le code pour que la ligne et la colonne aient la dimension de l'image

sur "ColumnWidth" j'ai écrit "30" au lieu de l'image.Width, modifiez cette valeur si nécessaire



VB: 
Private Sub deImageAFeuille(monImage, sht As Worksheet, r As Integer, c As Integer)

Dim pic As String, L As Double, T As Double
Dim Sh As Shape

pic = ThisWorkbook.Path & "\" & Format(Now, "yymmdd hhmmss") & ".jpg"

SavePicture monImage.Picture, pic

For Each Sh In sht.Cells(r, c).Parent.Shapes
    If Sh.Name = pic _
    Or (Sh.Top = sht.Cells(r, c).Top And Sh.Left = sht.Cells(r, c).Left) Then Sh.Delete
Next Sh

L = sht.Cells(r, c).Left: T = sht.Cells(r, c).Top

With sht.Shapes.AddPicture(FileName:=pic, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=L, Top:=T, Width:=-1, Height:=-1)
    .Placement = xlMove
    .OLEFormat.Object.PrintObject = msoTrue
    .OLEFormat.Object.Locked = msoTrue
    
End With

For Each Sh In sht.Cells(r, c).Parent.Shapes
    If (Sh.Left = sht.Cells(r, c).Left) Then
    sht.Range("F" & c).ColumnWidth = 30 'Sh.Width
    sht.Range("A" & r).RowHeight = Sh.Height
    End If
Next Sh

Kill pic

End Sub

J'espère aider
 
Vote positif 0 Vote négatif
job75 à dit:
Je pense que ce n'est pas possible, il faut copier l'image à la source
Cliquez pour agrandir...
Au temps pour moi, j'oubliais qu'il existe SavePicture, voyez ce fichier et la macro dans l'USF :
VB: 
Private Sub CommandButton1_Click()
If boxphoto.Picture Is Nothing Then Exit Sub
Dim fichier$, cellules, c, o As Object, i%
Application.ScreenUpdating = False
fichier = ThisWorkbook.Path & "\MonImage.jpg"
SavePicture boxphoto.Picture, fichier
cellules = Array("Feuil1!A2", "Feuil2!B2", "Feuil3!C2") 'liste des adresses à adapter
For Each c In cellules
    With Evaluate(c)
        .Parent.Visible = xlSheetVisible 'si la feuille est masquée
        Application.Goto .Cells
        For Each o In .Parent.DrawingObjects
            If o.TopLeftCell.Address = .Address Then o.Delete 'RAZ
        Next
        Set o = .Parent.Pictures.Insert(fichier)
        o.Placement = 2
        For i = 1 To 255
            .ColumnWidth = i: If .Width > o.Width Then Exit For
        Next i
        For i = 1 To 409
            .RowHeight = i: If .Height > o.Height Then Exit For
        Next i
    End With
Next c
Kill fichier
Feuil1.Activate
Application.ScreenUpdating = True
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
fanch55 à dit:
Une autre approche dans le classeur joint :
les images sont enregistrées dans une colonne d'un tableau structurée .

Elles sont plus petites que la cellule d'accueil pour pouvoir être détruites en même temps que la ligne du tableau.

A ce propos, pour tous les gourous de ce forum, je me heurte à un phénomène énervant:
l'image de la première ligne du tableau n'est jamais détruite sinon manuellement...
Cliquez pour agrandir...

Merci à vous c'est exactement ce dont j'ai besoin, mais dans votre code pour créer une nouvelle ligne et ensuite à l'aide de la variable "row" vous insérer votre image si je ne me trompe pas.

Serait-il possible justement d'adapter le code. J'ai deja essayé d'adapter ton code mais l'image s'affiche sur la mauvaise cellule. Elle s'affiche sur "activecell" alors que je voudrais qu'elle s'affiche sur activecell.offset(0,4). Ci joint ton code adapté:
VB: 
Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
           
   
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
           
                TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
   
                ' Injection du fichier temporaire dans une form Image de la feuille
             With ActiveCell.Offset(0, 4).Parent.Pictures.Insert(TempFileName)
                .Placement = xlMoveAndSize
                .PrintObject = msoFalse
                .ShapeRange.LockAspectRatio = msoFalse
       
                .Height = boxphoto.Height
                .Width = boxphoto.Width

            End With
           
                Unload Me

Merci 🙂
 
Vote positif 0 Vote négatif
Rhysand à dit:
Bonjour à tous

Width:=-1, Height:=-1 -> cela signifie que l'image conserve sa taille d'origine

J'ai changé le code pour que la ligne et la colonne aient la dimension de l'image

sur "ColumnWidth" j'ai écrit "30" au lieu de l'image.Width, modifiez cette valeur si nécessaire



VB: 
Private Sub deImageAFeuille(monImage, sht As Worksheet, r As Integer, c As Integer)

Dim pic As String, L As Double, T As Double
Dim Sh As Shape

pic = ThisWorkbook.Path & "\" & Format(Now, "yymmdd hhmmss") & ".jpg"

SavePicture monImage.Picture, pic

For Each Sh In sht.Cells(r, c).Parent.Shapes
    If Sh.Name = pic _
    Or (Sh.Top = sht.Cells(r, c).Top And Sh.Left = sht.Cells(r, c).Left) Then Sh.Delete
Next Sh

L = sht.Cells(r, c).Left: T = sht.Cells(r, c).Top

With sht.Shapes.AddPicture(FileName:=pic, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=L, Top:=T, Width:=-1, Height:=-1)
    .Placement = xlMove
    .OLEFormat.Object.PrintObject = msoTrue
    .OLEFormat.Object.Locked = msoTrue
   
End With

For Each Sh In sht.Cells(r, c).Parent.Shapes
    If (Sh.Left = sht.Cells(r, c).Left) Then
    sht.Range("F" & c).ColumnWidth = 30 'Sh.Width
    sht.Range("A" & r).RowHeight = Sh.Height
    End If
Next Sh

Kill pic

End Sub

J'espère aider
Cliquez pour agrandir...

Bonjour, merci pour votre réponse

Dans votre code à quoi correspond ces commandes svp :
Code: 
    .OLEFormat.Object.PrintObject = msoTrue
    .OLEFormat.Object.Locked = msoTrue

Merci d'avance
 
Vote positif 0 Vote négatif
Yesss j'ai réussi je vous met le code que j'ai adapter ci joint.
Merci à tous pour votre aide et votre patience avec moi 🙂🙂

Code: 
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
            
    
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
            
                TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
    
                ' Injection du fichier temporaire dans une form Image de la feuille
             ActiveCell.Offset(0, 4).Select
             With Selection.Parent.Pictures.Insert(TempFileName)
                .Placement = xlMoveAndSize
                .PrintObject = msoFalse
                .ShapeRange.LockAspectRatio = msoFalse
        
                .Height = boxphoto.Height
                .Width = boxphoto.Width
                

            End With
            
                Unload Me
 
Vote positif 0 Vote négatif
Maathis à dit:
Yesss j'ai réussi je vous met le code que j'ai adapter ci joint.
Merci à tous pour votre aide et votre patience avec moi 🙂🙂

Code: 
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
           
   
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
           
                TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
   
                ' Injection du fichier temporaire dans une form Image de la feuille
             ActiveCell.Offset(0, 4).Select
             With Selection.Parent.Pictures.Insert(TempFileName)
                .Placement = xlMoveAndSize
                .PrintObject = msoFalse
                .ShapeRange.LockAspectRatio = msoFalse
       
                .Height = boxphoto.Height
                .Width = boxphoto.Width
               

            End With
           
                Unload Me
Cliquez pour agrandir...

J'ai crié victoire un peu trop vite.
L'image s'insère bien au bon endroit et au début la cellule prenait la taille de l'image, mais maintenant la ligne reste à la même taille sans s'adapter à l'image 🙄

Merci d'avance
 
Vote positif 0 Vote négatif
Bonjour,

J'ai ajouté ces lignes de commande si vous souhaitez imprimer l'image avec les données de la feuille de calcul et si l'objet (image) est protégé ou non.

= Vrai, apparaît sur la feuille d'impression;
= Faux, lors de l'impression, n'apparaît pas

et pour la protection de l'objet, c'est pareil

🙂
 
Vote positif 0 Vote négatif
VB: 
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
             
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
                    TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                    SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
   
                ' Injection du fichier temporaire dans une form Image de la feuille
                 ActiveCell.Offset(0, 4).Select
                 With Selection.Parent.Pictures.Insert(TempFileName)
                    .Placement = xlFreeFloating
                        .PrintObject = msoFalse
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Height = boxphoto.Height
                        .Width = boxphoto.Width
               
                        Selection.RowHeight = boxphoto.Height
                        If Selection.Width > boxphoto.Width _
                        Then Selection.Columns.ColumnWidth = 1
                       
                         Do While Selection.Width < boxphoto.Width
                             Selection.Columns.ColumnWidth = _
                             Selection.Columns.ColumnWidth + 1
                         Loop
                    .Placement = xlMoveAndSize
                End With
           
                Unload Me
 
Vote positif 0 Vote négatif
Solution
fanch55 à dit:
VB: 
                Range("B100000").End(xlUp).Offset(1, 0).Select
                ActiveCell = Me.ID
                ActiveCell.Offset(0, 1) = Me.txtL
                ActiveCell.Offset(0, 2) = Me.txtC
                ActiveCell.Offset(0, 3) = Me.cbA
            
                ' Sauvegarde de l'image de l'Usf sur un ficher temporaire
                Set Fso = CreateObject("Scripting.FileSystemObject")
                    TempFileName = Environ("Temp") & "\" & Fso.GetTempName()
                    SavePicture boxphoto.Picture, TempFileName
                Set Fso = Nothing
  
                ' Injection du fichier temporaire dans une form Image de la feuille
                 ActiveCell.Offset(0, 4).Select
                 With Selection.Parent.Pictures.Insert(TempFileName)
                    .Placement = xlFreeFloating
                        .PrintObject = msoFalse
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Height = boxphoto.Height
                        .Width = boxphoto.Width
              
                        Selection.RowHeight = boxphoto.Height
                        If Selection.Width > boxphoto.Width _
                        Then Selection.Columns.ColumnWidth = 1
                      
                         Do While Selection.Width < boxphoto.Width
                             Selection.Columns.ColumnWidth = _
                             Selection.Columns.ColumnWidth + 1
                         Loop
                    .Placement = xlMoveAndSize
                End With
          
                Unload Me
Cliquez pour agrandir...

Merci beaucoup, ça marche exactement comment je voulais 😀
Merci à tous pour votre aide
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Résolu(e)
XL 2021 insertion d'image provenant d'unecellule dans un userform
2
Réponses
22
Affichages
255
vgendron
vgendron
N
  • Résolu(e)
XL 2021 erreur Vba
2
Réponses
21
Affichages
2 K
Oneida
Oneida
patricktoulon
  • Question Question
XL 2013 enregistrer la capture d'une shape avec les api avec transparence
2
Réponses
26
Affichages
1 K
patricktoulon
patricktoulon
patricktoulon
  • Question Question
Autres la fonction similaire
Réponses
11
Affichages
483
patricktoulon
patricktoulon
Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
638
Nico2978
Nico2978
D
  • Question Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
708
crocrocro
C
Messan
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
736
Messan
Messan
N
  • Question Question
XL 2021 Inclure dans mail une image déjà dans le fichier .xlm
Réponses
9
Affichages
479
nano33320
N
A
  • Question Question
XL 2010 Contrôles dans USF avant ajout
Réponses
5
Affichages
662
Oneida
Oneida
M
  • Question Question
Microsoft 365 Contrôles Validation Formulaire
2
Réponses
15
Affichages
1 K
mld.sebastien
M
mromain
Génération de QR Codes
Réponses
1
Affichages
836
Cousinhub
Cousinhub
T
  • Question Question
XL 2019 Comparer la valeur numérique de 2 textbox
Réponses
6
Affichages
1 K
terrier
T
K
  • Question Question
Microsoft 365 écriture via code vba
Réponses
10
Affichages
857
soan
S
V
  • Résolu(e)
XL 2021 Complétion d'un tableau automatisée
Réponses
9
Affichages
931
VincentH.DR
V
Y
  • Résolu(e)
XL 2016 Transfère des données réparties sur des lignes à une base de données
Réponses
12
Affichages
2 K
soan
S
Y
  • Question Question
XL 2019 Copie des données des différentes lignes sur une base de données
Réponses
10
Affichages
1 K
YANNISE
Y
R1-
  • Résolu(e)
XL 2016 Saisie automatique dans SAP via Excel
Réponses
1
Affichages
1 K
Dranreb
Dranreb
Maathis
  • Question Question
XL 2016 Image Useform
2 3
Réponses
39
Affichages
5 K
Maathis
Maathis
A
  • Question Question
XL 2019 Problème de décallage d'images à l'importation
Réponses
2
Affichages
996
Airpege
A
C
  • Question Question
XL 2019 Envoi mail : Condition dans un HTMLBODY
Réponses
2
Affichages
717
Cheyenne_2021
C
Retour