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

Microsoft 365 modifier les valeurs de mon formulaire

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 !

kingbeck

XLDnaute Nouveau
Salut la team, je voudrais avoir votre aide sur ce code :
lorsque je modifie les valeurs de mon userform1 tout se passe bien sauf l'image qui ne se modifie pas après le clic sur le bouton modifier et a la place c'est du blanc qui s'affiche.
 
Bonjour.
À tout hasard, mon module de classe CAssoImg, membre spécifique de ControlsAssociés pour un MSForms.Image :
VB:
Option Explicit
Implements CAsso
Private Parent As ControlsAssociés, WithEvents Img As MSForms.Image, Index As Long, _
   Colonne As Long, Dossier As String, UsMode, RéfFic As String, Conteneur As Object
Private Sub CAsso_Init(ByVal Lui As ControlsAssociés, ByVal Ctl As MSForms.IControl, ByVal Idx As Long, _
   ByVal Col As Long, ByVal Fmt As String, ByVal Mode As Variant)
   Set Parent = Lui: Set Img = Ctl: Index = Idx: Colonne = Col: UsMode = Mode
   Dossier = Fmt
   Set Conteneur = Ctl.Parent
   End Sub
Private Function CAsso_Ctl() As MSForms.IControl
   Set CAsso_Ctl = Img
   End Function
Private Function CAsso_Index() As Long
   CAsso_Index = Index
   End Function
Private Function CAsso_Col() As Long
   CAsso_Col = Colonne
   End Function
Private Function CAsso_Format() As String
   CAsso_Format = Dossier
   End Function
Private Function CAsso_Mode() As Variant
   CAsso_Mode = UsMode
   End Function
Private Property Let CAsso_Valeur(ByVal RHS As Variant)
   On Error Resume Next
   If Dossier <> "" And RHS <> "" Then
      Img.Picture = LoadPicture(Dossier & "\" & RHS)
   Else
      Img.Picture = LoadPicture(RHS)
      End If
   If Err = 0 Then RéfFic = RHS Else MsgBox RHS & vbLf & Err.Description, vbExclamation, "Image"
   Conteneur.Repaint
   End Property
Private Property Get CAsso_Valeur() As Variant
   CAsso_Valeur = RéfFic
   End Property
Private Sub Img_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   Dim GOFn
   If Button = 1 Then
      If Dossier <> "" Then ChDrive Dossier: ChDir Dossier
      GOFn = Application.GetOpenFilename("Image,*.jpg;*.gif;*.bmp")
      If VarType(GOFn) <> vbString Then Exit Sub
      If Dossier <> "" Then If Left$(GOFn, Len(Dossier) + 1) <> Dossier & "\" Then MsgBox _
         "Image non rattachée au dossier :" & vbLf & Dossier, vbCritical, "Image" _
         Else CAsso_Valeur = Mid$(GOFn, Len(Dossier) + 2) Else CAsso_Valeur = GOFn
   ElseIf Button = 2 Then
      If CAsso_Valeur = "" Then Exit Sub
      If MsgBox("Voulez-vous effacer cette image ?", vbYesNo, "Clic droit") = vbNo Then Exit Sub
      CAsso_Valeur = ""
      End If
   Parent.CAM_Change Me
   End Sub
 
Bonjour,
Et aussi à tout hasard, une image insérée dans un Control dynamiquement créé ou pas (selon la constante de compilation conditionnelle IMAGE_CONTROL_DYNAMIQUE) dans un UserForm. A adapter selon besoins.
VB:
#Const IMAGE_CONTROL_DYNAMIQUE = False

Private Sub CommandButton1_Click()
    Dim FichierImage As Variant
    Dim Image As MSForms.Image
    Const NomControlImage = "Image1"
 
    FichierImage = Application.GetOpenFilename("fichiers image Files (*.jpg;*.jpeg;*.gif;*.bmp), InutileMaisObligatoire", 1, "Ouvrir un fichier")
    If FichierImage = False Then Exit Sub
 
#If IMAGE_CONTROL_DYNAMIQUE Then
    On Error Resume Next
    Me.Controls.Remove NomControlImage
    On Error GoTo 0
 
    Set Image = Me.Controls.Add("Forms.Image.1", NomControlImage)
 
    With Image
        .Top = 50
        .Left = 50
        .Width = 300
        .Height = 300
    End With
#Else
    Set Image = Me.Controls(NomControlImage)
#End If

    With Image
        .PictureSizeMode = fmPictureSizeModeZoom
        .Picture = LoadPicture(FichierImage)
    End With
End Sub
 
Dernière édition:
Merci dudu2 ton code règle parfaitement le problème.
 
- 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

Réponses
2
Affichages
117
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…