Sujet Précédent Sujet Suivant

Userform et Image, insertion et dimensionnement

Résolu/Fermé
MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017 - Modifié par MrLafa le 5/03/2017 à 09:04
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 - 6 mars 2017 à 14:14
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
A voir également:

3 réponses

Réponse 1 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié par cs_Le Pivert le 5/03/2017 à 10:42
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
MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017
5 mars 2017 à 12:53
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
Réponse 2 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié par cs_Le Pivert le 5/03/2017 à 20:02
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
MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017
5 mars 2017 à 20:53
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
Réponse 3 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié par cs_Le Pivert le 6/03/2017 à 08:16
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
MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017
Modifié par MrLafa le 6/03/2017 à 12:47
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729 > MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017
6 mars 2017 à 12:57
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
MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017 > cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024
6 mars 2017 à 13:07 
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
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729 > MrLafa Messages postés 9 Date d'inscription vendredi 3 mars 2017 Statut Membre Dernière intervention 6 mars 2017
6 mars 2017 à 14:14
Voilà une bonne raison de mettre Option Explicit

https://grenier.self-access.com/access/visual-basic/de-linteret-de-option-explicit/

@+
0

Discussions similaires

PIX
plart -
jordane45 -

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

11 réponses
sortir des réseaux sociaux
barbapapy -
Xileh -

1 réponse
Impossible de télécharger photos messenger
Morgane -
Utilisateur anonyme -

1 réponse
problème de pixel
bernie33260 -
contrariness -

14 réponses