Sub Image1_Cliquer()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PO As String 'déclare la variable PO (Onglet POste)
Dim PR As String 'déclare la variable PR (PRocessus)
Dim CO As String 'déclare la variable CO (COnseiller(ère))
Dim DA As Date 'déclare la variable DA (DAte)
Dim LI As Integer 'déclare la variable LI (LIgne)
Dim CAND As Byte 'déclare la variable CAND (CANDidat)
Select Case IsFileOpen(Range("Consolidation.filename").Value)
Case False
'OK the file exists and is closed
Case True
MsgBox "Le fichier de consolidation étant actuellement ouvert, la consolidation ne peut être complétée. Veuillez essayer à nouveau plus tard." & vbCrLf & vbCrLf & _
Range("Consolidation.filename").Value
Exit Sub
Case Else
MsgBox "Le fichier de consolidation n'étant présentement pas accessible, la consolidation ne peut être complétée. Veuillez essayer à nouveau plus tard." & vbCrLf & vbCrLf & _
Range("Consolidation.filename").Value
Exit Sub
End Select
Application.ScreenUpdating = False
Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = radio2 'définit l'onglet source OS
On Error Resume Next
Set CD = Workbooks.Open(filename:=Range("Consolidation.filename").Value)
If Err <> 0 Then
MsgBox "Le fichier de consolidation étant actuellement ouvert, la consolidation ne peut être complétée. Veuillez fermer le fichier et essayer à nouveau."
Application.ScreenUpdating = True
Exit Sub
End If
On Error GoTo 0
' Set CD = Workbooks("BD_candidats-entrevues.xlsx") 'définit le classeur destination CD
Set OD = GetWsFromCodeName(CD, "d010") 'définit l'onglet destination OD
' Set OD = CD.Worksheets("Data") 'définit l'onglet destination OD
'définit la cellule de destination DEST (A2 si A2 est vide, sinoin la première celllue vide de la colonne A de l'onglet OD)
Set DEST = OD.Range("tbConso").Range("a1").Offset(10000, 0).End(xlUp)
If DEST.Address <> OD.Range("tbConso").Range("a1").Address Then Set DEST = DEST.Offset(1, 0)
' Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Range("A1").End(xlDown).Offset(1, 0))
PO = OS.Range("C3") 'définit le poste PO
PR = OS.Range("C4") 'définit la processus PR
CO = OS.Range("C5") 'définit le conseiller(ère) CO
DA = OS.Range("C12").Value 'définit la date DA
For LI = 15 To 29 'boucle sur les lignes 15 à 29
Select Case LI 'agit en fonction de la ligne LI
Case 15 'cas 15
CAND = 0 'définit le candidat CAND
Case 17 'cas 17
CAND = 1 'définit le candidat CAND
Case 25 'cas 25
CAND = 2 'définit le candidat CAND
Case 27 'cas 27
CAND = 3 'définit le candidat CAND
Case 29 'cas 29
CAND = 4 'définit le candidat CAND
Case Else 'autre cas
GoTo suite 'va à l'e'tiquette "suite"
End Select 'fin de l'action en fonction de la ligne LI
'renvoie le nom du candidat dans DEST décalée de cand ligne(s) vers le bas et 0 colonne vers la droite
DEST.Offset(CAND, 0) = OS.Cells(LI, 3).Value
'renvoie le poste PO dans DEST décalée de cand ligne(s) vers le bas et 1 colonne vers la droite
DEST.Offset(CAND, 1).Value = PO
'renvoie le processus PR dans DEST décalée de cand ligne(s) vers le bas et 2 colonnes vers la droite
DEST.Offset(CAND, 2).Value = PR
'renvoie le conseiller(ère) CO dans DEST décalée de cand ligne(s) vers le bas et 3 colonnes vers la droite
DEST.Offset(CAND, 3).Value = CO
'renvoie la date DA dans DEST décalée de cand ligne(s) vers le bas et 4 colonnes vers la droite
DEST.Offset(CAND, 4) = DA
suite: 'étiquette
Next LI 'prochaine ligne de la boucle
Application.DisplayAlerts = False
CD.Save
CD.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub GetConsolidationFileName()
Dim FName
FName = Application.GetOpenFilename(Title:="Please choose a file to open", FileFilter:="Excel Files *.xls* (*.xls*),")
If FName = False Then
'do nothing
Else
Range("Consolidation.filename").Value = FName
End If
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
IsFileOpen = errnum
End Select
End Function
Function GetWsFromCodeName(wb As Workbook, CodeName As String) As Excel.Worksheet
Dim ws As Excel.Worksheet
For Each ws In wb.Worksheets
If ws.CodeName = CodeName Then
Set GetWsFromCodeName = ws
Exit For
End If
Next ws
End Function
