Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1546 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  probleme excel en mode partager

 



 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

probleme excel en mode partager

n°2329674
douvillegr​eg
Posté le 24-02-2019 à 19:23:31  profilanswer
 

: 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

mood
Publicité
Posté le 24-02-2019 à 19:23:31  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  probleme excel en mode partager

 

Sujets relatifs
Qu'est ce qui est à la mode en 2019 ?Problème alignement
Problème code pour un lecteur radio en html5Problème avec WHERE et un nombre
[Divers] Outlook vers Excelliste des feuilles d'un fichier excel
Problème navigation de page wpfLier textbox excel avec une table access
Problème pour structurer le résultat d'une requete SQLCréation d'une alarme et gestion du mode veille d'un téléphone
Plus de sujets relatifs à : probleme excel en mode partager


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR