Userform et Image, insertion et dimensionnement

Résolu
MrLafa Messages postés 9 Statut Membre -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
Bonjour,

je suis entrain de travailler sur un petit programme, jusqu’à présent j'étais pleinement satisfait de mon code.
Le principe étant que utilisateur renseigne un formulaire (userform), avec des infos texte et image. Ces infos sont ensuite envoyées vers une base de donné.
Ma BDD appartenait au même classeur que l'userform, je souhaite maintenant externalisé cette BDD.

Hors je n'arrive pas à adapter mon code
L'image insérée dans l'USF refuse de s’insérer dans la feuille du classeur externe (aucun message d'erreur à l’exécution)

De plus, je me suis rendu compte que le code que j'utilise ne garde pas les proportions de l'image, je souhaiterai donc également adapter le code dans ce sens.

Quelqu'un pourrait il m'aider?

Je travaille sous office 2016

Merci par avance 

Private Sub UserForm_Initialize()

    'Chemin base de donnée
    Workbooks.Open ("C:\Users\kentin\Desktop\Fiche NC\BDD_en_cours.xlsx")

Application.Wait Now + TimeValue("0:00:02")

    'feuille BDD

    Dim MNC As Worksheet

    'feuille maquette NC

    Set MNC = Workbooks("BDD_en_cours").Sheets("Maquette NC")

End Sub

.
.

Private Sub CommandButton10_Click()
On Error Resume Next

Dim L As Single, T As Single, W As Single, H As Single

cheminComplet = Application.GetOpenFilename

   Me.Image8.Picture = LoadPicture(cheminComplet)
   Me.Image8.Visible = True
   TextBox160.Text = "Ok"

      ' Image dans la feuille

With MNC

    L = .Range("C18").Left
    T = .Range("C18").Top
    W = .Range("C18:E18").Width
    H = .Range("C18:E18").Height

    .Shapes.AddPicture cheminComplet, True, True, L, T, W, H
    .Shapes(5).Name = "photoNOK"
    .Shapes.Range(Array("NOk")).Select
    .ShapeRange.ZOrder msoBringToFront

 End With

On Error GoTo 0

End Sub

3 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    comme ceci à adapter: 

    Private Sub UserForm_Initialize()
'Chemin base de donnée
    Workbooks.Open ("C:\Users\LePivert\Documents\essai.xlsx")'a adapter
End Sub
Sub InsertionImage()
Dim Emplacement As Range
Application.Dialogs(xlDialogInsertPicture).Show
Workbooks("essai.xlsx").Worksheets("Feuil1").Activate 'a adapter
    Set Emplacement = Range("C18:E25")
    Selection.Left = Emplacement.Left
    Selection.Top = Emplacement.Top
    Selection.Height = Emplacement.Height
    Selection.Width = Emplacement.Width
    Selection.Name = "photoNOK"
 End Sub


    @+ Le Pivert
    0
    1. MrLafa Messages postés 9 Statut Membre
       
      Merci d'avoir pris le temps de m'aider, ton code marche très bien pour insérer l'image dans la BDD

      Cependant je perds la prévisualisation de l'image dans le userform.
      "me.image8" dans le code de mon premier message

      Aurais tu une solution?
      0
  2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Comme ceci a adapter: 

    Option Explicit
Private Const Fichier As String = "C:\Users\LePivert\Documents\mondossier\ImageTemp.gif"  'a adapter
Private Sub CommandButton1_Click()
InsertionImage
End Sub
Private Sub UserForm_Initialize()
'Chemin base de donnée
    Workbooks.Open ("C:\Users\LePivert\Documents\mondossier\essai.xlsx") 'a adapter
End Sub
Private Sub UserForm_Terminate()
   'Supprime l'image temporaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
End Sub
Sub InsertionImage()
Dim Emplacement As Range
Dim nb As Byte
   Dim Sh As Shape
 'Supprime l'image temporaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
 Application.Dialogs(xlDialogInsertPicture).Show
Workbooks("essai.xlsx").Worksheets("Feuil1").Activate
    Set Emplacement = Range("C18:E25")
    Selection.Left = Emplacement.Left
    Selection.Top = Emplacement.Top
    Selection.Height = Emplacement.Height
    Selection.Width = Emplacement.Width
    Selection.Name = "photoNOK"
    'Définit le 1er shape de la feuille comme image
    ' à afficher dans l'UserForm
    Set Sh = Worksheets("Feuil1").Shapes(1)
    'copie le shape dans la feuille
    Sh.CopyPicture
    'crée un graphique
    With ActiveSheet.ChartObjects.Add(0, 0, _
                        Sh.Width, Sh.Height).Chart
        .Paste 'colle l'image dans graphique
        ' enregistre le graphique au format gif
        .Export Fichier, "gif"
    End With
  nb = ActiveSheet.ChartObjects.Count
    'supprime le graphique
    ActiveSheet.ChartObjects(nb).Delete
    'Affiche l'image dans le graphique
    Image1.Picture = LoadPicture(Fichier)
 End Sub

    @+ Le Pivert
    0
    1. MrLafa Messages postés 9 Statut Membre
       
      Merci encore pour le temps que tu pense à bidouiller tout ça

      Le Option Explicit met le bazar dans mes variables défini dans le UserForm_Initialize(), elles ne sont plus reconnu...

      D'autre part, j'ai bossé un peu dessus cet après midi, j'ai réussi à bricoler un code qui fait ce que j'ai besoin.

      Mais il se passe quelque chose incompréhensible
      j'ai donc une code, deux photo au même format, le code ne réagit pas pareil en fonction de la photo
      Pour la première, tout ce passe bien, insertion, positionnement et dimensionnement
      Pour la seconde le code se contente de m’insérer la photo...

      je ne comprends pas.. 

      'Dim L As Single, T As Single, W As Single, H As Single
      'Dim Emplacement As Range
      ''
      'chemincomplet = Application.GetOpenFilename
      '
      '   Me.Image8.Picture = LoadPicture(chemincomplet)
      '   Me.Image8.Visible = True
      '   TextBox160.Text = "Ok"
      '
      '    MNC.Range("B6").Select
      '    ActiveSheet.Pictures.Insert(chemincomplet).Select
      '    Selection.ShapeRange.Name = "photoNOK"
      '    MNC.Shape("photoNOK").Select
      '
      '
      '    Selection.Left = Range("C18").Left
      '    Selection.Top = Range("C18").Top
      '    Selection.Height = Range("C18:E31").Height
      0
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    voici le code,: 

    Private Sub CommandButton1_Click()
Dim Emplacement As Range
Dim chemincomplet As String

chemincomplet = Application.GetOpenFilename
 Me.Image1.Picture = LoadPicture(chemincomplet)
  ' Me.Image8.Visible = True
   'TextBox160.Text = "Ok"
'  MNC.Range("B6").Select
Workbooks("essai.xlsx").Worksheets("Feuil1").Activate
    ActiveSheet.Pictures.Insert(chemincomplet).Select
    Selection.ShapeRange.Name = "photoNOK"
    'MNC.Shape("photoNOK").Select
 Selection.Left = Range("C18").Left
  Selection.Top = Range("C18").Top
   Selection.Height = Range("C18:E31").Height
End Sub
Private Sub UserForm_Initialize()
 Workbooks.Open ("C:\Users\LePivert\Documents\essai.xlsx") 'a adapter
End Sub

    @+ Le Pivert
    0
    1. MrLafa Messages postés 9 Statut Membre
       
      Merci beaucoup!

      Hors images, le transfert du contenue des textbox vers ma base de donnée marchait très bien
      Et à force de bidouiller à droite à gauche, ce transfert ne marche plus, erreur "424 objet requis"

      Je pense que cela vient de la déclaration des variables, débutant en VBA je suis un peu perdu 

      Private Sub UserForm_Initialize()

          'Application.Visible = False

          'Date
          Me.TextBox131.Text = Format(Now, "dd/mm/yyyy")

          'Format date
          Me.TextBox156.Text = Format(Now, "yy")

          'Chemin base de donnée
          Workbooks.Open ("N:\xxxxx\xxxxxxxxx\xxxxxxxxxxx\xxxxxx\BDD_en_cours.xlsx")

      Application.Wait Now + TimeValue("0:00:02")

          'feuille BDD
          Dim BDD As Worksheet
          Dim MNC As Worksheet
          Dim FPF As Worksheet
          Dim PLV As Long
          Dim DLP As Long


          'feuille BDD
          Set BDD = Workbooks("BDD_en_cours.xlsx").Sheets("BDD")

          'feuille maquette NC
          Set MNC = Workbooks("BDD_en_cours.xlsx").Sheets("Maquette NC")

          'feuille parametre
          Set FPF = Workbooks("BDD_en_cours.xlsx").Sheets("FPF Finale")

          'Premiere Ligne vide
          PLV = BDD.Range("A1").End(xlDown).Offset(1, 0).Row

          'Derniere Ligne Plein
          DLP = BDD.Range("A1").End(xlDown).Row

          'Increment référence
          If BDD.Range("A3") = "" Then
              Me.TextBox157.Text = "1"
            Else: Me.TextBox157.Text = BDD.Range("S" & DLP).Value + 1
          End If

      End Sub

      Private Sub CommandButton12_Click()

          'copie des données vers BDD

      With BDD

          .Range("A" & PLV) = TextBox11.Value
          .Range("B" & PLV) = TextBox118.Value
          .Range("C" & PLV) = TextBox9.Value
          .Range("D" & PLV) = TextBox10.Value
          .Range("E" & PLV) = TextBox162.Value
          .Range("F" & PLV) = TextBox21.Value
          .Range("G" & PLV) = TextBox22.Value
          .Range("H" & PLV) = TextBox24.Value
          .Range("I" & PLV) = TextBox163.Value

      .
      .
      .

      .End with

      End sub
      0
      1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > MrLafa Messages postés 9 Statut Membre
         
        Là on sort de la demande initiale.

        Je pense que cela vient de la déclaration des variables, débutant en VBA je suis un peu perdu

        pourquoi mettre Option Explicit ?

        pour déclarer toutes les variables

        Sans le classeur on ne peux pas beaucoup aider!

        Si le problème est résolu au niveau de l'image, cliquez sur résolu.
        Faire un nouveau post pour ce nouveau problème.

        @+ Le Pivert
        0
      2. MrLafa Messages postés 9 Statut Membre > cs_Le Pivert Messages postés 8437 Statut Contributeur
          
        Là on sort de la demande initiale.


        En effet, je clos ce sujet et en ré-ouvre un autre

        En tout cas merci beaucoup à toi
        0

Discussions similaires

PIX
plart -
jordane45 -

1 réponse
Comment enlever le rouge sur la photo svp ?
lucas0909 -
bazfile -

11 réponses
Retrouver l'image originale d'une photo modifiée
Raven -
Asta972155 -

10 réponses
Supprimer une couleur d'une image
Ticki84 -
Utilisateur anonyme -

3 réponses