VBA placer rdv dans un fichier planning

Option Explicit

Const FeuillePlanning = "Feuil2"
Const Sec10ieme = 1# / 24 / 60 / 60 / 10

Public Sub Placer_RdV(ByVal alaDate, ByVal alheure, ByVal Nom)
Dim xdate As Range, xRdV As Range, i&

With ThisWorkbook.Sheets(FeuillePlanning)
  'recherche date - dans ligne 2
  Set xdate = .Rows(2).Find(what:=alaDate, LookIn:=xlValues, lookat:=xlWhole)
  If xdate Is Nothing Then
    'date pas trouvée - message et fin
    MsgBox "la date n'a pas été trouvée -> abandon"
    Exit Sub
  Else
    'recherche heure - boucle sur colonne A
    For i = 3 To 26
      If Abs(.Cells(i, "a") - alheure) < Sec10ieme Then Exit For
    Next i
    If i > 26 Then
      'heure pas trouvée - message et fin
      MsgBox "l'heure n'a pas été trouvée -> abandon"
      Exit Sub
    Else
      'heure trouvée - 1ière cellule des 4 possibles
      Set xRdV = .Cells(i, xdate.Column)
      'vérif si disponibilité - parcours des 4 cellueles à partir de xRdV
      For i = 0 To 3
        If IsEmpty(xRdV.Offset(i)) Then Exit For
      Next i
      If i > 3 Then
        'pas de cellule dispo - message et fin
        MsgBox "Plus aucun créneau dispo. à l'heure souhaitée -> abandon "
        Exit Sub
      Else
        'placement du Nom
        xRdV.Offset(i) = Nom
        MsgBox "RdV de : " & Nom & vbLf & "placé le : " & _
          Format(alaDate, "dddd dd mmmm yyyy") & " à " & Format(alheure, "hh:mm")
      End If
    End If
  End If
End With
End Sub

Option Explicit

Const CheminPlanning = "C:\FORUM1"
Const Nomplanning = "PLANNING.xlsm"

Sub PrendreRdV()
Dim wbk As Workbook, FichierPlanning$
Application.ScreenUpdating = False
  'vérif fichier planning ouvert. Si non, l'ouvrir
  FichierPlanning = CheminPlanning & IIf(Right(CheminPlanning, 1) = "\", "", "\") & Nomplanning
  On Error Resume Next
    'attibution à l'objet wbk
    Set wbk = Workbooks(Nomplanning)
    If wbk Is Nothing Then
      'le planning n'est pas ouvert, on va l'ouvrir
      Set wbk = Workbooks.Open(FichierPlanning)
      If wbk Is Nothing Then
        'le planning n'était pas ouvert et on n'arrive pas à l'ouvrir
        MsgBox "Le Fichier Planning est introuvable" & vbLf & vbLf _
            & FichierPlanning & vbLf & vbLf & "-> Abandon!"
        Exit Sub
      End If
    End If
  On Error GoTo 0
  
  If Not wbk Is Nothing Then
    'si le Planning est ouvert => placer le RdV
    With ThisWorkbook.ActiveSheet
      'lancer la macro Placer_RdV au sein du fichier planning
      Application.Run "'" & Nomplanning & "'!" & "Placer_RdV", _
          .Cells(3, "b"), .Cells(4, "b"), .Cells(2, "b")
      'fermeture planning
      wbk.Close True
    End With
  End If
'Fin
Application.ScreenUpdating = True
End Sub