Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 AIDE Useform Image

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:


Merci d'avance
 
Solution
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

fanch55

XLDnaute Barbatruc
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

  • Maathis.xlsm
    24.9 KB · Affichages: 13
Vote positif 0 Vote négatif
R

Rhysand

XLDnaute Junior
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

XLDnaute Barbatruc
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

  • Images(1).xlsm
    37.3 KB · Affichages: 7
Vote positif 0 Vote négatif

Maathis

XLDnaute Nouveau

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

Maathis

XLDnaute Nouveau

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

Maathis

XLDnaute Nouveau
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

XLDnaute Nouveau

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
R

Rhysand

XLDnaute Junior
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

fanch55

XLDnaute Barbatruc
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

Maathis

XLDnaute Nouveau

Merci beaucoup, ça marche exactement comment je voulais
Merci à tous pour votre aide
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Résolu(e)
XL 2021 erreur Vba
2
Réponses
21
Affichages
2 K
Oneida
  • Question
XL 2013 enregistrer la capture d'une shape avec les api avec transparence
2
Réponses
26
Affichages
926
patricktoulon
  • Question
Autres la fonction similaire
Réponses
11
Affichages
436
patricktoulon
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
550
Nico2978
D
  • Question
XL 2021 VBA - Erreur 1004 aléatoire - Image/Logo
Réponses
10
Affichages
650
crocrocro
C
N
  • Question
XL 2021 Inclure dans mail une image déjà dans le fichier .xlm
Réponses
9
Affichages
452
nano33320
N
  • Résolu(e)
XL 2019 Organiser les données dans listbox
Réponses
2
Affichages
692
Messan
A
  • Question
XL 2010 Contrôles dans USF avant ajout
Réponses
5
Affichages
650
Oneida
Génération de QR Codes
Réponses
1
Affichages
749
Cousinhub
T
  • Question
XL 2019 Comparer la valeur numérique de 2 textbox
Réponses
6
Affichages
1 K
terrier
T
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…