Import de fichier pdf avec userform

H

heparti

XLDnaute Occasionnel
Bonjour,

J'arrive à la fin de mes problème :p:p

Un des dernier pour lesquels je ne trouve pas de solution est le suivant :

Dans le code suivant, j'affiche et je recopie un lien hypertexte dans une feuille excel, à condition que l'image concernée soit déposée par les utilisateurs dans un répertoire définit.

Or, je préfèrerait que les utilisateurs puissent, par le biais d'un bouton aller chercher un fichier .pdf disponible sur un réseau (le sélectionner) et qu'en validant l'userform, ça recopie le fichier .pdf dans un autre répertoire d'un autre réseau (modifiable dans la macro si besoin) et que ça affiche le lien hypertexte dans la colonne prévue (colonne L).

Il n'est pas nécessaire d'utiliser un aperçu dans le userform.

Merci pour vos pistes et idées ;)

Code: 
Dim Img

Private Sub Label4_Click()

End Sub

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Création IND"
    ComboBox1.AddItem "Création DOS"
    ComboBox1.AddItem "Déplacement"
    Label5.Visible = False: Tbx_DOS.Visible = False
        UserForm1.Height = 65
End Sub
Private Sub ComboBox1_Change()

    Cbx_Image.Clear
    FichImg = Dir(ActiveWorkbook.Path & "\PJ\*.jpg")
    Do While FichImg <> ""
        Cbx_Image.AddItem FichImg
        FichImg = Dir
    Loop
    With Sheets("Données")
        For Each CelNom In .Range("A2:A" & .Range("A65000").End(xlUp).Row)
            Cbx_Nom.AddItem CelNom.Value
        Next
     
    End With
    If Sheets("BD").Range("A2") = "" Then
        Tbx_Fiche = 1
    Else
        Tbx_Fiche = Sheets("BD").Range("A65000").End(xlUp) + 1
    End If
    Tbx_Temps.Visible = False
    Tbx_Temps.BackColor = &H8000000F
    Me.Top = 50
    Label5.Visible = ComboBox1.ListIndex >= 1
    Tbx_DOS.Visible = ComboBox1.ListIndex >= 1
    Label16.Visible = ComboBox1.ListIndex = 2
    Tbx_IND.Visible = ComboBox1.ListIndex = 2
    UserForm1.Height = 500

End Sub
Private Sub OptionButton8_Change()
    Tbx_Temps.Visible = OptionButton8
    Tbx_Temps.BackColor = IIf(OptionButton8, &H8000000E, &H8000000F)
End Sub
Private Sub Cbx_Image_Change()
    Image1.Picture = LoadPicture("")
    If Cbx_Image = "" Then Exit Sub
    Img = ActiveWorkbook.Path & "\PJ\" & Cbx_Image
    Image1.Picture = LoadPicture(Img)
End Sub
Private Sub Btn_Valider_Click()
Sheets("BD").Unprotect Password:="test"
    With Sheets("BD")
        Derlign = .Range("A65000").End(xlUp).Row + 1
        .Range("A" & Derlign) = Tbx_Fiche
        .Range("B" & Derlign) = Tbx_HEURE
        .Range("D" & Derlign) = Cbx_Nom
        .Range("E" & Derlign) = Tbx_NUMDOS
        .Range("F" & Derlign) = Tbx_Ref
        .Range("G" & Derlign) = Tbx_Materiel
        .Range("H" & Derlign) = Tbx_NumSerie
        .Range("I" & Derlign) = Tbx_Qte
        .Range("J" & Derlign) = Tbx_DATEN
        .Range("K" & Derlign) = Tbx_DescriptionNC
        .Range("L" & Derlign) = Tbx_CauseNC
        .Range("O" & Derlign) = Tbx_IND
        .Range("Q" & Derlign) = Tbx_DATEN
        .Range("C" & Derlign) = Tbx_DATEDEM
        .Range("R" & Derlign) = Cbx_MOTIF
        If Cbx_Image <> "" Then
            .Hyperlinks.Add Anchor:=.Range("L" & Derlign), Address:=Img, TextToDisplay:=Cbx_Image.Text
        End If
        For i = 2 To 7
            If Controls("OptionButton" & i).Value = True Then
                Tbx_Temps = Controls("OptionButton" & i).Caption
                Exit For
            End If
        Next
        .Range("M" & Derlign) = Tbx_Temps
        .Range("N" & Derlign) = Tbx_IND
    End With
    Unload Me
        Sheets("BD").Protect Password:="test"
End Sub
Private Sub Btn_Annuler_Click()
    Unload Me
End Sub
Private Sub UserForm_Activate()
Tbx_DATEDEM.Value = Format(Date, "dd/mm/yyyy")
Tbx_HEURE.Value = Format(Now, "hh:nn:ss")
End Sub

    Private Sub Tbx_DATEN_Change()
    Dim Valeur As Byte
    Tbx_DATEN.MaxLength = 10 'nb caracteres maxi dans textbox
    Valeur = Len(Tbx_DATEN)
    If Valeur = 2 Or Valeur = 5 Then Tbx_DATEN = Tbx_DATEN & "/"
    End Sub
 
Trier par date Trier par votes
H

heparti

XLDnaute Occasionnel
Re : Import de fichier pdf avec userform

Merci pour ce fil de discussion mais je n'arrive pas à adapter ces codes à mes besoins.

J'ai réussi à ajouter l'enregistrement automatique pour que les utilisateurs n'aient pas à enregistrer le fichier après avoir validé la macro.

De plus, le problème du classeur protégé en mode "partagé" me pose de gros problèmes...

Voici le code revu à ce jour :

Code: 
Dim Img

Private Sub Label4_Click()

End Sub

Private Sub UserForm_Initialize()
    ComboBox1.AddItem "Création de Dossier"
    ComboBox1.AddItem "Création d'individu"
    ComboBox1.AddItem "Transfert d'individu"
    Label5.Visible = False: Tbx_DOS.Visible = False
        UserForm1.Height = 65
End Sub
Private Sub ComboBox1_Change()

    Cbx_Image.Clear
    FichImg = Dir(ActiveWorkbook.Path & "\PJ\*.jpg")
    Do While FichImg <> ""
        Cbx_Image.AddItem FichImg
        FichImg = Dir
    Loop
    With Sheets("Données")
        For Each CelNom In .Range("A2:A" & .Range("A65000").End(xlUp).Row)
            Cbx_Nom.AddItem CelNom.Value
        Next
     
    End With
    If Sheets("BD").Range("A2") = "" Then
        Tbx_Fiche = 1
    Else
        Tbx_Fiche = Sheets("BD").Range("A65000").End(xlUp) + 1
    End If
    Tbx_Temps.Visible = False
    Tbx_Temps.BackColor = &H8000000F
    Me.Top = 50
    Label5.Visible = ComboBox1.ListIndex >= 1
    Tbx_DOS.Visible = ComboBox1.ListIndex >= 1
    Label16.Visible = ComboBox1.ListIndex = 2
    Tbx_IND.Visible = ComboBox1.ListIndex = 2
    UserForm1.Height = 500
    Tbx_TRAIT = (Tbx_DATEDEM) + (Tbx_Temps)
End Sub
Private Sub OptionButton8_Change()
    Tbx_Temps.Visible = OptionButton8
    Tbx_Temps.BackColor = IIf(OptionButton8, &H8000000E, &H8000000F)
End Sub
Private Sub Cbx_Image_Change()
    Image1.Picture = LoadPicture("")
    If Cbx_Image = "" Then Exit Sub
    Img = ActiveWorkbook.Path & "\PJ\" & Cbx_Image
    Image1.Picture = LoadPicture(Img)
End Sub
Private Sub Btn_Valider_Click()
    With Sheets("BD")
        Derlign = .Range("A65000").End(xlUp).Row + 1
        .Range("A" & Derlign) = Tbx_Fiche
        .Range("B" & Derlign) = Tbx_HEURE
        .Range("D" & Derlign) = Cbx_Nom
        .Range("J" & Derlign) = Tbx_PRENOM
        .Range("E" & Derlign) = Tbx_Ref
        .Range("K" & Derlign) = Tbx_Adresse
        .Range("F" & Derlign) = Tbx_NumSerie
        .Range("G" & Derlign) = Tbx_Qte
        .Range("M" & Derlign) = Tbx_DATEN
        .Range("H" & Derlign) = Tbx_DescriptionNC
        .Range("M" & Derlign) = Tbx_CauseNC
        .Range("O" & Derlign) = Tbx_IND
        .Range("C" & Derlign) = Tbx_DATEDEM
        .Range("S" & Derlign) = Cbx_MOTIF
        .Range("N" & Derlign) = Tbx_DOS
        .Range("Q" & Derlign) = Tbx_TRAIT
        .Range("I" & Derlign) = Tbx_NOMMAR
        If Cbx_Image <> "" Then
            .Hyperlinks.Add Anchor:=.Range("N" & Derlign), Address:=Img, TextToDisplay:=Cbx_Image.Text
        End If
        For i = 2 To 4
            If Controls("OptionButton" & i).Value = True Then
                Tbx_Temps = Controls("OptionButton" & i).Caption
                Exit For
            End If
        Next
        .Range("P" & Derlign) = Tbx_Temps
        .Range("N" & Derlign) = Tbx_IND
    End With
    Unload Me
    ThisWorkbook.Save
End Sub
Private Sub Btn_Annuler_Click()
    Unload Me
End Sub
Private Sub UserForm_Activate()
Tbx_DATEDEM.Value = Format(Date, "dd/mm/yyyy")
Tbx_HEURE.Value = Format(Now, "hh:nn:ss")
End Sub

    Private Sub Tbx_DATEN_Change()
    Dim Valeur As Byte
    Tbx_DATEN.MaxLength = 10 'nb caracteres maxi dans textbox
    Valeur = Len(Tbx_DATEN)
    If Valeur = 2 Or Valeur = 5 Then Tbx_DATEN = Tbx_DATEN & "/"
    End Sub
    
    Private Sub Tbx_TRAIT_Change()
    Dim Valeur As Byte
    Tbx_DATEN.MaxLength = 10 'nb caracteres maxi dans textbox
    Valeur = Len(Tbx_DATEN)
    If Valeur = 2 Or Valeur = 5 Then Tbx_DATEN = Tbx_DATEN & "/"
    End Sub

Private Sub Btn_PJ_Click()
    Unload Me
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
418
Mody200
M
tactic6
  • Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
166
tactic6
tactic6
E
  • Question
XL 2016 Execution de deux ComboBox dans un UserForm
Réponses
7
Affichages
496
Jacky67
Jacky67
S
  • Question
XL 2013 recherche intuitif semi automatique dans Combobox (trié et avec valeur unique) inseré en UserForm VBA
2
Réponses
18
Affichages
424
Sghaier Chafaa
S
D
  • Question
Microsoft 365 Application.WorksheetFunction.VLookup ne fonctionne pas au delà de 8500 lignes
Réponses
4
Affichages
297
DimiJuju
D
O
  • Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
448
ChTi160
ChTi160
Usine à gaz
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
361
Usine à gaz
Usine à gaz
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
375
un internaute
U
K
  • Résolu(e)
XL 2019 Combobox affiche 2 fois Msgbox
Réponses
12
Affichages
362
Kevin38
K
Dadi147
  • Résolu(e)
XL 2019 Importer des données de colonne spécifiques dans combobox
Réponses
4
Affichages
626
fanfan38
fanfan38

Membres actuellement en ligne

20 membres et 305 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 193
Messages
2 086 059
Membres
103 110
dernier inscrit
Privé