: Bonjour merci d avance petit problème mon fichier fonctionne très bien en lecture seule des que je veux le mettre en mode partage il mais une erreur d exécution 1004 je n arrive pas a sol
Private Sub CheckBox12_Click()
 
End Sub
 
Private Sub CheckBox5_Click()
 
End Sub
 
Private Sub CheckBox6_Click()
 
End Sub
 
Private Sub CheckList_Click()
 
End Sub
 
Private Sub ComboBox1_Change()
 
End Sub
 
Private Sub CommandButton3_Click()
 
 'Appeler le calendrier
    TB = 2
        Pose = Me.Top + Me.TextBox11.Top + (Me.TextBox11.Height * 2)
        Pose = Pose & ";" & Me.Left + Me.TextBox11.Left
    Calendrier.Show
End Sub
 
 
Private Sub CommandButton4_Click()
 
 'Appeler le calendrier
    TB = 3
        Pose = Me.Top + Me.TextBox6.Top + (Me.TextBox6.Height * 2)
        Pose = Pose & ";" & Me.Left + Me.TextBox6.Left
    Calendrier.Show
End Sub
Private Sub CommandButton5_Click()
TB = 1
        Pose = Me.Top + Me.TextBox8.Top + (Me.TextBox8.Height * 2)
        Pose = Pose & ";" & Me.Left + Me.TextBox6.Left
    Calendrier.Show
End Sub
 
   
Private Sub CommandButton6_Click()
    Unload UserForm_Saisie
End Sub
 
Private Sub Dates_Click()
 
End Sub
 
Private Sub Identité_Click()
 
End Sub
 
Private Sub Label12_Click()
 
End Sub
 
 Private Sub TextBox5_AfterUpdate() 'Heure Décès
  TextBox5 = Replace(Replace(Replace(Me.TextBox5, ":", ":" ), "/", ":" ), "::", "h" )
End Sub
 
Private Sub TextBox7_AfterUpdate() 'Heure Frigo
 TextBox7 = Replace(Replace(Replace(Me.TextBox7, ":", ":" ), "/", ":" ), "::", "h" )
 
End Sub
 
'Private Sub CheckBox1_Click() ' COntrôle et affiche message selon choix
 
'If CheckBox1.Value = True Then
'msgbox "Main Gauche Sélectionnée"
'End If
'If CheckBox1.Value = False Then
'msgbox "Main Droite Sélectionnée"
'End If
'End Sub
 
'Private Sub CheckBox2_Click() ' COntrôle et affiche message selon choix
 
'If CheckBox2.Value = True Then
'End If
'msgbox "Cheville Droite Sélectionnée"
'End If
'End Sub
Private Sub CheckBox8_AfterUpdate()
If CheckBox8.Value = True Then
CheckBox9.Value = False
CheckBox10.Value = False
End If
End Sub
 
Private Sub CheckBox9_AfterUpdate()
If CheckBox9.Value = True Then
CheckBox8.Value = False
CheckBox10.Value = False
End If
End Sub
 
Private Sub CheckBox10_AfterUpdate()
If CheckBox10.Value = True Then
CheckBox8.Value = False
CheckBox9.Value = False
End If
End Sub
 
Private Sub ComboBox2_AfterUpdate() 'Autopsie
    If ComboBox2.Value = "" Then
    msgbox "Sélectionner NON si pas d'Autopsie"
    End If
   'If ComboBox2.Value <> "Non" Then
  ' msgbox "Saisir une Date"
  ' End If
End Sub
 
 
Private Sub CommandButton1_Click()  'SAISIE
'Affichage Boite Saisie
    'Controle Remplissage Texbox Non et Prénom
    If TextBox2 = "" Then
    msgbox "Saisir un Nom et un Prénom"
    TextBox2.SetFocus
    Exit Sub
    End If
   
     
    'Controle Remplissage Texbox Prénon
  '  If TextBox3 = "" Then
  '  msgbox "Saisir un Prénom"
  '  TextBox3.SetFocus
  '  Exit Sub
  '  End If
    'Controle Remplissage Texbox Date de Décès
    'If TextBox11.Value = "" Then
       ' msgbox "Saisir une Date de Décès"
      'TextBox11.SetFocus
       ' Exit Sub
    ' End If
 
    'Controle Remplissage Texbox Heure de Décès
   ' If TextBox5.Value = "" Then
        'msgbox "Saisir une Heure de Décès"
      'TextBox5.SetFocus
       ' Exit Sub
    ' End If
      'Controle Remplissage Combobox Provenance
    If ComboBox1.Value = "" Then
        msgbox "Choisir une Provenance"
      ComboBox1.SetFocus
        Exit Sub
     End If
     'Controle Remplissage Combobox Autopsie
    If ComboBox2.Value = "" Then
        msgbox "Choisir Type d'Autopsie"
        ComboBox2.SetFocus
        Exit Sub
        If ComboBox2.Value <> "Non" Then
  ' msgbox "Saisir une Date"
   TextBox8.SetFocus
   End If
     End If
      If TextBox12 = "" Then
    msgbox "Saisir un Nom d'Agent"
    TextBox12.SetFocus
    Exit Sub
    End If
ActiveSheet.Unprotect Password:=("0022" ) 'Ôte la protection de la feuille
 
 
Call Increment
    temp = ""
   For Each c In Civilité.Controls
     If c.Value = True Then
       temp = c.Caption
     End If
   Next c
 
 
        ActiveCell.Offset(0, 1).Value = temp
        ActiveCell.Offset(0, 2).Value = Application.Proper(TextBox2)    'Nom
      '  ActiveCell.Offset(0, 3).Value = Application.Proper(TextBox3)    'Pénom
 
        If TextBox6.Value = "" Then
GoTo line1
        End If
        ActiveCell.Offset(0, 3).Value = CDate(TextBox11)                
        ActiveCell.Offset(0, 4).Value = TextBox5                        
        ActiveCell.Offset(0, 5).Value = CDate(TextBox6)                  
        ActiveCell.Offset(0, 6).Value = TextBox7                        
       
line1:
 
         ActiveCell.Offset(0, 20).Value = TextBox12                       'Nom Agent
        ActiveCell.Offset(0, 7).Value = ComboBox1                      'Provenance
         ActiveCell.Offset(0, 8).Value = TextBox13                       'Service
        If ComboBox1.Value = "Réquisition" Then
     ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 3
       End If
 
       
       ActiveCell.Offset(0, 10).Value = ComboBox2
       If ComboBox2.Value = "Autopsie Anapath" Then
     ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 35
       End If
       ActiveCell.Offset(0, 10).Value = ComboBox2
       If ComboBox2.Value = "Autopsie Foetopath" Then
     ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 35
       End If
       ActiveCell.Offset(0, 10).Value = ComboBox2
       If ComboBox2.Value = "R P O" Then
     ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 35
     End If
       ActiveCell.Offset(0, 10).Value = ComboBox2
       If ComboBox2.Value = "Don Fac" Then
     ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 39
       End If
      ActiveCell.Offset(0, 10).Value = ComboBox2
       If ComboBox2.Value = "" Then
     'ActiveSheet.Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 18)).Interior.ColorIndex = 39
     ActiveCell.Offset(0, 10).Interior.ColorIndex = 39
         ActiveCell.Offset(0, 0).Interior.ColorIndex = 39
       End If
        'OML
        If CheckBox5.Value = True Then
      ActiveCell.Offset(0, 9).Value = "Oui"                 'Si coché ...
        ActiveCell.Offset(0, 9).Interior.ColorIndex = 3     'Rouge
         ActiveCell.Offset(0, 0).Interior.ColorIndex = 3     'Rouge
       Else
       
      ActiveCell.Offset(0, 9).Value = "Non"                 'Si non coché ...
        ActiveCell.Offset(0, 9).Interior.ColorIndex = 2     'Blanc
      End If
       
        'AUTOPSIE
         
        ActiveCell.Offset(0, 10).Value = ComboBox2          
        If ComboBox2.Value <> "Non" Then
       ' ActiveCell.Offset(0, 11).Value = CDate(TextBox8)    
      End If
      'MESURE
        ActiveCell.Offset(0, 13).Value = TextBox9            
    'Kit Décès
      If CheckBox6.Value = True Then 'Si coché ...            
      ActiveCell.Offset(0, 14).Value = "Oui"
      Else 'Si non coché ...
      ActiveCell.Offset(0, 14).Value = "Non"
         
    End If
     
    'Cases Controle Bracelets (Identification)
    If CheckBox1.Value = True Then
    ActiveCell.Offset(0, 16).Value = "M-D"      'Poignet Gauche si COCHE
   ' Else
    'ActiveCell.Offset(0, 16).Value = "M-G"
    End If
    If CheckBox11.Value = True Then
    ActiveCell.Offset(0, 16).Value = "M-G"      'Poignet Droit si COCHE
    'Else
   ' ActiveCell.Offset(0, 16).Value = "M-D"
    End If
     
   If CheckBox2.Value = True Then
     ActiveCell.Offset(0, 17).Value = "C-G"     'Cheville Gauche si COCHE
   ' Else
   ' ActiveCell.Offset(0, 17).Value = "P-D"
    End If
    If CheckBox12.Value = True Then
     ActiveCell.Offset(0, 17).Value = "C-D"     'Cheville Gauche si COCHE
   ' Else
   ' ActiveCell.Offset(0, 17).Value = "P-D"
    End If
   
     
     
     
       If CheckBox7.Value = True Then 'Si coché ...
    ActiveCell.Offset(0, 18).Value = "Oui"
       Else
       ActiveCell.Offset(0, 18).Value = "Non"
       End If
         
         
     If ActiveCell.Offset(0, 10).Value = "Non" Then 'Si Radio="Non"
      ActiveCell.Offset(0, 11).ClearContents        'On efface la Date
       
     End If
    Msg = msgbox("Voulez vous faire un autre enregistrement ?", vbYesNoCancel + vbExclamation, "Choisir de laisser Excel Ouvert !" )
    If Msg = 6 Then     'Réponse "Oui"
     
    Unload UserForm_Saisie
   UserForm_Saisie.Show
     
  ' Call nettoie
   
    If Msg = 7 Then     'Réponse "Non"
     End If
 
    Call SORTIE
   
    SaveChanges = False
   Call UserForm_Saisie_Initialize
     Range("a3:a5000" ).Select
     selection.End(xlDown).Select
     ActiveCell.Offset(1, 0).Range("a1" ).Select
     ActiveSheet.Protect Password:=("0022" )
   '  UserForm_Saisie.Show
     ' ActiveWorkbook.Save
    End If
    ActiveCell.Offset(1, 0).Range("a1" ).Select
     ActiveSheet.Protect Password:=("0022" )
    Unload UserForm_Saisie
End Sub
 
Private Sub UserForm_Saisie_Initialize()
   CheckBox8.SetFocus
End Sub
 
Sub nettoie()
    TextBox2 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    TextBox8 = ""
    TextBox9 = ""
    TextBox11 = ""
    TextBox12 = ""
    TextBox13 = ""
    ComboBox1 = ""
    ComboBox2 = ""
    CheckBox1 = ""
    CheckBox2 = ""
    CheckBox5 = ""
    CheckBox6 = ""
    CheckBox7 = ""
    CheckBox8 = ""
    CheckBox9 = ""
  Unload UserForm_Saisie
   UserForm_Saisie.Show
End Sub
Sub SORTIE()
     Range("a3:a5000" ).Select
   selection.End(xlDown).Select
   ActiveCell.Offset(1, 0).Range("a1" ).Select
   ActiveSheet.Protect Password:=("0022" )
  Unload UserForm_Saisie
End Sub
 
Sub nettoie2()
    TextBox2 = ""
    TextBox5 = ""
    TextBox6 = ""
    TextBox7 = ""
    TextBox8 = ""
    TextBox9 = ""
    TextBox11 = ""
    TextBox12 = ""
    TextBox13 = ""
    ComboBox1 = ""
    ComboBox2 = ""
    CheckBox1 = ""
    CheckBox2 = ""
    CheckBox5 = ""
    CheckBox6 = ""
    CheckBox7 = ""
    CheckBox8 = ""
    CheckBox9 = ""
     
End Sub
 
Private Sub UserForm_Click()
 
End Sub
utionner