Private Sub CmdValider_Click() Dim CTRL As Control 'Variable pour la collection des controls
Dim WS_del As Worksheet 'Variable pour un Objet Worksheet
Dim I As Integer
Dim numero, match, Response As Integer
Dim utilisateur As String
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig
Dim L, X As Integer
Dim val_type, val_fam, val_prod, val_proc, val_deno, val_nbmod As String
Dim rSV, rDV, critV As String
Dim Fso
Dim nom_fichier As String
'On déprotège la page
'ActiveSheet.Unprotect Password:="xxx"
'On identifie l'objet pour la feuille de travail
'Set WS_del = ThisWorkbook.Sheets("BD")
Set WS = ThisWorkbook.Sheets("DataBase")
'On identifie la dernière ligne vide en partant du bas
DerniereLigne = Worksheets("BD").Cells(65536, 11).End(xlUp).Row + 1
'On met le login windows dans une variable
utilisateur = Environ("username")
Valeur_Test = utilisateur
'On va voir si on trouve la valeur testée dans la liste des personnes autorisées.
Set Lig = Range(Worksheets("BD").Cells(1, 11), Worksheets("BD").Cells(DerniereLigne, 11)).Find(Valeur_Test, LookIn:=xlValues, LookAt:=xlWhole)
If Not Lig Is Nothing Then
GoTo Granted 'Si on la trouve, alors on continue.
Else
GoTo Denied 'Si on ne la trouve pas, alors on s'arrête là.
End If
Granted:
'MsgBox "Access Granted !" 'message d'information
'ici une série de contrôles, si le numéro ou le type ou la description est vide, on set le focus dessus
If ComboBox0.Value = "" Then MsgBox "Remplissez le type de document et le numéro du document !", vbCritical, T: ComboBox0.SetFocus: Exit Sub
If TextBox2.Value = "" Then MsgBox "Remplissez le type de document et le numéro du document !", vbCritical, T: TextBox2.SetFocus: Exit Sub
'Si les données sont correctement renseignées alors création de la variable numero
numero = Format(TextBox2.Value, "0")
'On vide les combobox Famille, produit et process car on ne peut les changer en validation
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
'On réaffiche la valeur du numero
TextBox2.Value = Format(numero, "000")
'On identifie l'objet pour la feuille de travail
Set WS = ThisWorkbook.Sheets("DataBase")
'On identifie la dernière ligne vide en partant du bas
L = WS.Range("A65536").End(xlUp).Row + 1
With WS
'Recherche de la ligne correspondant au couple (type, numéro)
For X = 2 To L
If Me.ComboBox0 & Format(numero, "000") = WS.Range("E" & X) & WS.Range("F" & X) Then
match = match + 1: I = X
End If
Next X
'Si la ligne existe déjà alors on poursuit
If match > 0 Then
'Ci-après, on test si le fichier est déjà validé ou supprimé
'Test : si date de validation, mais pas de date de suppression, alors fichier dans _production
If .Range("M" & I) <> "" And .Range("O" & I) = "" Then
MsgBox "Erreur, le fichier est déjà validé !", vbInformation, T
GoTo Fin
End If
'Test : Si date de suppression, alors erreur et on sort de la fonction "MODIFIER" pour revenir à l'écran de choix !
If .Range("O" & I) <> "" Then
MsgBox "Erreur, un document archivé ne peut être validé"
GoTo Fin
End If
'Initialisation des valeurs
val_type = WS.Cells(I, 5)
val_fam = WS.Cells(I, 1)
val_prod = WS.Cells(I, 2)
val_proc = WS.Cells(I, 3)
val_deno = WS.Cells(I, 4)
'val_num = WS.Cells(i, 6)
'Ici un message demandant d'accepter les changement en les listant
Response = MsgBox("Récapitulatif des informations : " & vbCrLf & vbCrLf & _
"Attention, en validant ce document, vous le rendrez disponnible sur le réseau xxx" & ChrW(174) & "." & vbCrLf & vbCrLf & _
"Merci de vous assurer de l'exactitude de son contenu." & vbCrLf & _
"Il sera enregistré dans le dossier C:\" & vbCrLf & vbCrLf & _
"Type : " & vbTab & vbTab & val_type & vbCrLf & _
"Numéro : " & vbTab & vbTab & Format(numero, "000") & vbCrLf & _
"Produit : " & vbTab & vbTab & val_prod & vbCrLf & _
"Process : " & vbTab & vbTab & val_proc & vbCrLf & _
"Dénomination : " & vbTab & val_deno & vbCrLf & vbCrLf & _
"Validez-vous ce document ? ", vbQuestion + vbOKCancel, T & " Validation de : " & val_type & "_" & Format(numero, "000"))
'Si Réponse OK on continue
If Response = 1 Then
'ici avec la Feuille on va faire :
.Range("M" & I) = Format(Now, "dd-mmm-yyyy") 'On écrit dans la colonne M la date de validation
.Range("N" & I) = utilisateur 'On écrit dans la colonne N le nom de la personne qui valide
'On sélectionne la ligne afin d'y appliquer la mise en forme voulue : couleur verte
.Range("A" & I, "P" & I).Select
Selection.Interior.ColorIndex = 35
'Fonction déplacement
Set Fso = CreateObject("Scripting.FileSystemObject")
'On définit le répertoire source comme le répertoire _pending et les sous-répertoires correspondants
rSV = ThisWorkbook.Sheets("BD").Range("O3") & "\" & .Range("A" & I) & "\" & .Range("C" & I) & "\"
'On définit le répertoire cible comme le répertoire _production et les sous-répertoires correspondants
rDV = ThisWorkbook.Sheets("BD").Range("O4") & "\" & .Range("A" & I) & "\" & .Range("C" & I) & "\"
'On définit la variable crit comme le nom du fichier
critV = .Range("G" & I)
'Avant déplacement, on vient écrire ci-après un lien hypertexte pointant vers le fichier
.Hyperlinks.Add Anchor:=.Range("G" & I), Address:=rDV & critV & ".xls", TextToDisplay:=critV
'On déplace maintenant le fichier
Fso.MoveFile rSV & "*" & critV & "*.xls", rDV ', True
'On envoie un message de confirmation
MsgBox "Fichier validé et publié sur le réseau", vbInformation, T
Ini 'On lance la réinitialisation du UserForm (Macro en haut du Module)
'Si Réponse Annulation on envoie un message et on a rien fait
Else
MsgBox "Opération annulée", vbInformation, T
'Si le document recherché n'existe pas, alors on avertit l'utilisateur
End If
ElseIf match = 0 Then
MsgBox "Le document recherché n'existe pas dans la base de données !", vbExclamation, T & " Erreur recherche !"
GoTo Fin
End If
Denied:
MsgBox "Accès denied !", vbExclamation, T 'message d'information
GoTo Fin
Fin:
'On protège la page
'ActiveSheet.Protect Password:="xxx"
End With
End Sub
