1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
| -----------------------------------------------------------------------------------------------------
Voila le code de la feuille "Nomenclature"
-----------------------------------------------------------------------------------------------------
Option Explicit
Sub MAJ(Rep As Integer)
Dim Cel As Range
Dim Reference As String
Dim Chemin As String
Dim Verif As String
Select Case Rep
Case 1 'Chemin Photo
Reference = Sheets("Nomenclature").Range("D14", Sheets("Nomenclature").Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Nomenclature").Range("F14").Value & Reference & ".jpg"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune photo n'est associée à cet article")
Exit Sub
Else
UserForm1.Height = 600
UserForm1.Image1.Picture = LoadPicture(Chemin)
End If
Case 2 'Chemin Doc 1
Reference = Sheets("Nomenclature").Range("E14", Sheets("Nomenclature").Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Nomenclature").Range("F14").Value & Reference & ".doc"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune plan n'est associée à cet article")
Exit Sub
Else
UserForm3.WebBrowser1.Navigate Chemin
UserForm3.Show
End If
Case 3 'Chemin Doc 2
Reference = Sheets("Nomenclature").Range("E14", Sheets("Nomenclature").Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Paramétrage").Range("F14").Value & Reference & ".pdf"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune plan n'est associée à cet article")
Exit Sub
Else
UserForm3.WebBrowser1.Navigate Chemin
UserForm3.Show
End If
End Select
End Sub
-------------------------------------AutoRémplisageTable------------------------------------------
Private Sub UserForm_Activate()
Dim TotErr As Integer
Sheets("Nomenclature").Range("D14").AutoFilter
Sheets("Nomenclature").Range("D14").AutoFilter Field:=1, Criteria1:=Val_F
Sheets("Nomenclature").Range("D14").AutoFilter Field:=2, Criteria1:=Val_C
TotErr = Sheets("Nomenclature").AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
If TotErr = 1 Then
UserForm1.Hide
MsgBox ("Cette référence n'est pas présente dans la nomenclature")
Exit Sub
Else
UserForm1.Height = 120
Me.Text10 = Sheets("Nomenclature").Range("D13") & " : "
Me.Text11 = Sheets("Nomenclature").Range("D14", Sheets("Nomenclature").Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text12 = Sheets("Nomenclature").Range("E13") & " : "
Me.Text13 = Sheets("Nomenclature").Range("E14", Sheets("Nomenclature").Cells(Rows.Count, "E").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text14 = Sheets("Nomenclature").Range("C13") & " : "
Me.Text15 = Sheets("Nomenclature").Range("C14", Sheets("Nomenclature").Cells(Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text16 = Sheets("Nomenclature").Range("F13") & " : "
Me.Text17 = Sheets("Nomenclature").Range("F14", Sheets("Nomenclature").Cells(Rows.Count, "F").End(xlUp)).SpecialCells(xlCellTypeVisible).Value
End If
End Sub
-----------------------------------------------------------------------------------------------------
Voila le code de la feuille "Paramétrage".
----------------------Macro qui permet de mofifier le chemin de mon dossier photo---------------------
Private Sub Cmd_CheminPhoto_Click()
Dim Fenetre As String
Fenetre = Application.GetOpenFilename _
(FileFilter:="Tous les fichiers (*.*),*.* ", Title:="Sélectionnez un fichier")
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then
MsgBox ("Le chemin du répertoire photo est resté identique")
Exit Sub
Else
Sheets("Nomenclature").Range("F14").Value = Left(Fenetre, InStrRev(Fenetre, "\", -1))
UserForm4.Hide
MsgBox ("Le Chemin a bien été modifié")
End If
End Sub
'-----------------Macro qui permet de mofifier le chemin de mon dossier plan---------------
Private Sub Cmd_CheminPlan_Click()
Dim Fenetre As String
Fenetre = Application.GetOpenFilename _
(FileFilter:="Tous les fichiers (*.*),*.* ", _
Title:="Sélectionnez un fichier")
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then
MsgBox ("Le chemin du répertoire plan est resté identique")
Exit Sub
Else
Sheets("Nomenclature").Range("F14").Value = Left(Fenetre, InStrRev(Fenetre, "\", -1))
UserForm4.Hide
MsgBox ("Le Chemin a bien été modifié")
End If |
Partager