Bonjour,
J'arrive à la fin de mes problème
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
J'arrive à la fin de mes problème
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