Dim LIENHYPERTEXTE As String
Dim str As String
Dim lig As Long
Private Sub UserForm_Initialize()
' INITIALISATION DES DONNEES
' Met "SEBASTIEN" par défaut dans USER
USER.Value = "SEBASTIEN"
' Insére automatiquement la date du jour dans DateDeSaisie
DATESAISIE.Value = Format(Date, "dd/mm/yyyy")
' Insére automatiquement la date du jour dans DateRéponse
DATEREPONSE.Value = Format(Date, "dd/mm/yyyy")
' Met "A RELANCER" par défaut dans CommentairesCandidature
COMMENTAIRESCANDIDATURE.Value = "A RELANCER"
' Met "NC" par défaut dans REMUNERATION
REMUNERATION.Value = "NC"
' Met en gras les noms de SOCIETE
NOMSOCIETE.Font.Bold = True
' GENERE LES DONNEES POUR LES LISTES DE CHOIX
'on remplit la liste USER par les données de la colonne 22
Remplir Me.USER, 2
'on remplit la liste NOMSOCIETE par les données de la colonne 3
Remplir Me.NOMSOCIETE, 3
'on remplit la liste ZONE par les données de la colonne 4
Remplir Me.ZONE, 4
'on remplit la liste TYPESOCIETE par les données de la colonne 5
Remplir Me.TYPESOCIETE, 5
'on remplit la liste PRENOMCONTACT par les données de la colonne 8
Remplir Me.PRENOMCONTACT, 8
'on remplit la liste FONCTIONCONTACT par les données de la colonne 9
Remplir Me.FONCTIONCONTACT, 9
'on remplit la liste VILLESOCIETE par les données de la colonne 17
Remplir Me.VILLESOCIETE, 17
'on remplit la liste LOGIN par les données de la colonne 22
Remplir Me.LOGIN, 22
'on remplit la liste MDP par les données de la colonne 23
Remplir Me.MDP, 23
'on remplit la liste ANNONCESBYMAIL par les données de la colonne 24
Remplir Me.ANNONCESBYMAIL, 24
'on remplit la liste POSTE par les données de la colonne 32
Remplir Me.POSTE, 32
'on remplit la liste TYPEPOSTE par les données de la colonne 33
Remplir Me.TYPEPOSTE, 33
'on remplit la liste LIEU par les données de la colonne 34
Remplir Me.LIEU, 34
'on remplit la liste REMUNERATION par les données de la colonne 35
Remplir Me.REMUNERATION, 35
'on remplit la liste CANDIDATURE par les données de la colonne 40
Remplir Me.CANDIDATURE, 40
'on remplit la liste COMMENTAIRESCANDIDATURE par les données de la colonne 41
Remplir Me.COMMENTAIRESCANDIDATURE, 41
End Sub
'On remplit la listbox ou la combobox LST par les données de la colonne COL
Private Sub Remplir(ByVal LST As Object, ByVal Col As Integer)
Dim MonDico As Object
Dim f As Worksheet
Dim c As Range
Dim temp()
Set MonDico = CreateObject("Scripting.Dictionary")
Set f = Worksheets("BASE EMPLOI")
With f
For Each c In .Range(.Cells(2, Col), .Cells(.Rows.Count, Col).End(xlUp))
If c.Value <> "" Then MonDico.Item(c.Value) = c.Value
Next c
End With
Set f = Nothing
temp = MonDico.items
Set MonDico = Nothing
Call Tri(temp, LBound(temp), UBound(temp))
LST.List = temp
End Sub
Private Sub Tri(a(), ByVal gauc As Long, ByVal droi As Long) ' Quick sort
Dim G As Long, d As Long
Dim Ref, temp
Ref = a((gauc + droi) \ 2)
G = gauc: d = droi
Do
Do While a(G) < Ref: G = G + 1: Loop
Do While Ref < a(d): d = d - 1: Loop
If G <= d Then
temp = a(G): a(G) = a(d): a(d) = temp
G = G + 1: d = d - 1
End If
Loop While G <= d
If G < droi Then Call Tri(a, G, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Private Sub REPERAGE_Click()
If REPERAGE.Value = True Then
NOMCONTACT.Visible = False
' Met "A CANDIDATER" par défaut dans CommentairsCandidature
COMMENTAIRESCANDIDATURE.Value = "A CANDIDATER"
End If
If REPERAGE.Value = False Then
NOMCONTACT.Visible = True
' Met "A RELANCER" par défaut dans CommentairsCandidature
COMMENTAIRESCANDIDATURE.Value = "A RELANCER"
End If
End Sub
Private Sub FICHIERPDFANNONCE_Click()
If FICHIERPDFANNONCE.Value = True Then
CANDIDATURE.Value = "ANNONCE"
'Génére le lien hypertexte vers le fihier PDF
LIENHYPERTEXTE = Application.GetOpenFilename
str = LIENHYPERTEXTE
'Découpe le nom du fichier pdf de l'annonce
str = Right(str, Len(str) - InStr(str, " - ") - 2)
BASEEMPLOI.DATEANNONCE = Left(str, InStr(str, " - "))
'MsgBox Left(Str, InStr(Str, " - "))
str = Right(str, Len(str) - InStr(str, " - ") - 2)
BASEEMPLOI.NOMSOCIETE = Left(str, InStr(str, " - "))
'MsgBox Left(Str, InStr(Str, " - "))
str = Right(str, Len(str) - InStr(str, " - ") - 2)
BASEEMPLOI.POSTE = Left(str, Len(str) - 4)
'MsgBox Left(Str, Len(Str) - 4)
Dim TSpl$()
TSpl = Split(LIENHYPERTEXTE, " - ")
BASEEMPLOI.DATEANNONCE = Replace(TSpl(1), " ", "/")
BASEEMPLOI.NOMSOCIETE = TSpl(2)
BASEEMPLOI.POSTE = Replace(TSpl(3), ".pdf", "")
'CODEBASE.Value = USER.Value + "-" + SOCIETE.Value + "-" + POSTE.Value + "-" + DATESAISIE.Value
End If
End Sub
Private Sub PORTABLECONTACT_Change()
Dim Valeur As Byte
PORTABLECONTACT.MaxLength = 14
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(PORTABLECONTACT)
If Valeur = 2 Or Valeur = 5 Or Valeur = 8 Or Valeur = 11 Then PORTABLECONTACT = PORTABLECONTACT & " "
End Sub
Private Sub RELANCE_Change()
Dim Valeur As Byte
RELANCE.MaxLength = 10
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(RELANCE)
If Valeur = 2 Or Valeur = 5 Then RELANCE = RELANCE & "/"
End Sub
Private Sub DATEANNONCE_Change()
Dim Valeur As Byte
DATEANNONCE.MaxLength = 10
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(DATEANNONCE)
If Valeur = 2 Or Valeur = 5 Then DATEANNONCE = DATEANNONCE & "/"
End Sub
Private Sub DATEREPONSE_Change()
Dim Valeur As Byte
With Me.DATEREPONSE
.MaxLength = 10
Valeur = Len(.Value)
If Valeur = 2 Or Valeur = 5 Then
.Value = .Value & "/"
ElseIf Valeur = .MaxLength Then
Me.RELANCE = Format(CDate(.Value) + 4, "dd/mm/yyyy")
End If
End With
End Sub
Private Sub DATEINSCRIPTION_Change()
Dim Valeur As Byte
DATEINSCRIPTION.MaxLength = 10
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(DATEINSCRIPTION)
If Valeur = 2 Or Valeur = 5 Then DATEINSCRIPTION = DATEINSCRIPTION & "/"
End Sub
Private Sub DATEMAJ_Change()
Dim Valeur As Byte
DATEMAJ.MaxLength = 10
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(DATEMAJ)
If Valeur = 2 Or Valeur = 5 Then DATEMAJ = DATEMAJ & "/"
End Sub
Private Sub TELEPHONECONTACT_Change()
Dim Valeur As Byte
TELEPHONECONTACT.MaxLength = 14
'nb caracteres maxi dans textbox pour un format JJ/MM/AA
Valeur = Len(TELEPHONECONTACT)
If Valeur = 2 Or Valeur = 5 Or Valeur = 8 Or Valeur = 11 Then TELEPHONECONTACT = TELEPHONECONTACT & " "
End Sub
Private Sub VILLESOCIETE_Change()
If Me.VILLESOCIETE.ListIndex > -1 Then
With Me.LIEU
.Value = Me.VILLESOCIETE.Value
If .ListIndex = -1 Then .AddItem Me.VILLESOCIETE.Value
End With
End If
End Sub
Private Sub FIN_Click()
Application.ScreenUpdating = False
Worksheets("BASE EMPLOI").Select
Dim L As Integer
If MsgBox("Ajouter une nouvelle Société/Candidature ? ", vbYesNo, " Demande de confirmation d’ajout ") = vbYes Then
L = Sheets("BASE EMPLOI").Range("a65536").End(xlUp).Row + 1
'Evite le scintillement de l'écran
Application.ScreenUpdating = False
'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
Range("A" & L).Value = CODEBASE
Range("B" & L).Value = USER
Range("C" & L).Value = NOMSOCIETE
Range("D" & L).Value = ZONE
Range("E" & L).Value = TYPESOCIETE
Range("G" & L).Value = NOMCONTACT
Range("H" & L).Value = PRENOMCONTACT
Range("I" & L).Value = FONCTIONCONTACT
Range("J" & L).Value = TELEPHONECONTACT
Range("K" & L).Value = PORTABLECONTACT
Range("L" & L).Value = MAILCONTACT
Range("N" & L).Value = ADRESSESCOCIETE
Range("O" & L).Value = COMPLEMENTADRESSESOCIETE
Range("P" & L).Value = CPSOCIETE
Range("Q" & L).Value = VILLESOCIETE
Range("R" & L).Value = SITESOCIETE
Range("T" & L).Value = DATEINSCRIPTION
Range("U" & L).Value = DATEMAJ
Range("V" & L).Value = LOGIN
Range("W" & L).Value = MDP
Range("X" & L).Value = ANNONCESBYMAIL
Range("Y" & L).Value = COMMENTAIRES
Range("AF" & L).Value = POSTE
Range("AG" & L).Value = TYPEPOSTE
Range("AH" & L).Value = LIEU
Range("AI" & L).Value = REMUNERATION
Range("AJ" & L).Value = DATEANNONCE
Range("AK" & L).Value = DATEREPONSE
Range("AL" & L).Value = RELANCE
Range("AN" & L).Value = CANDIDATURE
Range("AO" & L).Value = COMMENTAIRESCANDIDATURE
Range("BB" & L).Value = DATESAISIE
'Génére le lien hypertexte vers le fihier PDF
If FICHIERPDFANNONCE.Value = True Then
ActiveSheet.Hyperlinks.Add Anchor:=Range("AN" & L), Address:= _
LIENHYPERTEXTE, _
TextToDisplay:=Range("AN" & L).Value
'Génére RDV GOOGLEAGENDA
If AGENDA.Value = True Then
Range("AQ" & L).Value = "OK"
End If
End If
End If
'Ferme l'USERFORM
Unload BASEEMPLOI
' Enléve les filtres
On Error Resume Next
Worksheets("BASE EMPLOI").ShowAllData
' Lance le classement par nom de Société
Call CLASSERPARNOMSOCIETE
' Met en format CenturyGothic Taille 8
Call CENTURYGOTHIC8
' Lance le classement par nom de Société
Call CLASSERPARNOMSOCIETE
' Met en format CenturyGothic Taille 8
Call CENTURYGOTHIC8
' Met en format DATE
' Call CONVERTIRDATES
' Tire les colonnes
Call COULEURCOLONNES
'Rétablit le scintillement de l'écran
Application.ScreenUpdating = True
'Etendre la zone d'impression
Call ZONEIMPRESSION
' Affiche Excel
Excel.Application.Visible = True
' Mise en forme conditionnelle "A TRAITER"
Call MFCATRAITER
' Call AGENDA
Worksheets("GESTION").Select
Range("B2").Select
Application.ScreenUpdating = True
End Sub
'================================== VALIDATION FORMAT DATE =================================
Private Sub DATESAISIE_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(DATESAISIE) = False Then MsgBox "Ceci n'est pas une date": DATESAISIE = "": Exit Sub
DATESAISIE.Value = CDate(Format(DATESAISIE.Value, "DD/MM/YYYY"))
End Sub
Private Sub DATEINSCRIPTION_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(DATEINSCRIPTION) = False Then MsgBox "Ceci n'est pas une date": DATEINSCRIPTION = "": Exit Sub
DATEINSCRIPTION.Value = CDate(Format(DATEINSCRIPTION.Value, "DD/MM/YYYY"))
End Sub
Private Sub DATEMAJ_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(DATEMAJ) = False Then MsgBox "Ceci n'est pas une date": DATEMAJ = "": Exit Sub
DATEMAJ.Value = CDate(Format(DATEMAJ.Value, "DD/MM/YYYY"))
End Sub
Private Sub DATEANNONCE_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(DATEANNONCE) = False Then MsgBox "Ceci n'est pas une date": DATEANNONCE = "": Exit Sub
DATEANNONCE.Value = CDate(Format(DATEANNONCE.Value, "DD/MM/YYYY"))
End Sub
Private Sub DATEREPONSE_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(DATEREPONSE) = False Then MsgBox "Ceci n'est pas une date": DATEREPONSE = "": Exit Sub
DATEREPONSE.Value = CDate(Format(DATEREPONSE.Value, "DD/MM/YYYY"))
End Sub
Private Sub RELANCE_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(RELANCE) = False Then MsgBox "Ceci n'est pas une date": RELANCE = "": Exit Sub
RELANCE.Value = CDate(Format(RELANCE.Value, "DD/MM/YYYY"))
End Sub
End Sub