Aide: Erreur dans le code

Private Sub CheckBox1_Click()
Dim i As Integer
ListBox1.MultiSelect = fmMultiSelectExtended
For i = 0 To Me![ListBox1].ListCount - 1
Me![ListBox1].Selected(i) = True
Next
End Sub

Private Sub Ferme_Click()
Unload Liste_contacts
End Sub

Private Sub UserForm_Initialize()
'modifié pour que la listbox ne s'alimente qu'avec les valeurs contenues dans
'la feuille Liste colonne H et "oublie" les cellules vides
Dim i, derlig As Integer
With Sheets("Liste")
derlig = .Range("H65536").End(xlUp).Row
For i = 2 To derlig
If .Cells(i, 8).Value <> Nouveau.Email.Value Then
ListBox1.AddItem .Cells(i, 8).Value
End If
Next i
End With
CheckBox1.Value = False
Dim Fichier As String
Dim img As Long
Dim hWnd As Long
Fichier = "D:\Carnet d'adresses\Images\carnet.ico"
img = Len(Dir(Fichier))
If img = 0 Then Exit Sub
img = ExtractIconA(0, Fichier, 0)
SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, img
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
End Sub

Private Sub Envois_Click()
Dim Chaine As String
Dim i As Byte
For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) Then
                      Chaine = Chaine & " " & ListBox1.List(i) & ";"
            End If
      Next i
  
    Dim olApp As Outlook.Application
    Dim Msg As MailItem
    Dim Chemin
    ChDrive "D"
    ChDir ("D:\Carnet d'adresses\")
    Set olApp = Outlook.Application
    Set Msg = olApp.CreateItem(olMailItem)
    
    Msg.To = Nouveau.Email.Value
    Msg.cc = ""
    Msg.BCC = Trim(Chaine)
    Msg.Subject = ""
    Msg.Body = ""
    Chemin = Application.GetOpenFilename("*.*, *.*")
If VarType(Chemin) <> 11 Then
Msg.Attachments.Add Chemin
End If
Msg.Display
End Sub