Amelioration vba et protection

Fermé

cedric0715 Messages postés 210 Date d'inscription mercredi 25 février 2015 Statut Membre Dernière intervention 6 mai 2018 - 28 nov. 2016 à 10:51
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 28 nov. 2016 à 15:01

Bonjour,
j'ai deux éléments a amélioré en via dans mon tableau

les donné de ma feuille "tableau recap sont le résultat de mon "userformpri" qui n est pas proteger ,mais des lors que je la protège mon spin button ne fonctionne pas trouvez le code si dessous

'enregistrement et protection blocage des donnees'

Private Sub CommandButton1_Click()
Dim l_info As Integer
Dim note_1 As String, note_2 As String, lanote As String
Dim Ws As Worksheet



With ThisWorkbook.Worksheets("TABLEAU RECAP")
 l_info = .Cells(.Rows.Count, 2).End(xlUp).Row + 1


     .Range("B" & l_info).Value = ComEQUI 'libelle equipement'
        .Range("c" & l_info).Value = Textlocal 'code local"
        .Range("D" & l_info).Value = ComRESP 'Nom du responsable'
        .Range("E" & l_info).Value = CDate(TextDATEAM) 'date du constat'
        .Range("F" & l_info).Value = CDate(TextMISE) 'date de mise en service'
        .Range("G" & l_info).Value = CInt(TextDUREVIE.Value)  'Duree de vie theorique'
        .Range("H" & l_info).Value = CDate(TextREMPL) 'Date theorique de remplacement '
        .Range("I" & l_info).Value = CInt(TextDURVIERESI.Value)  'Duree de vie residuelle '
        .Range("J" & l_info).Value = TextESTIMREMPL 'Duree de vie residuelle '
        .Range("K" & l_info).Value = CInt(TextRESUETAT.Value) 'note de etat equipement'
        .Range("l" & l_info).Value = CInt(TextRESUCRIT.Value) 'note de criticite equipement'

With .Range("M" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Mauvais"",IF(RC[-2]<=43,""Usuel"",IF(RC[-2]<=64,""Bon"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_1 = .Value
         End With

         With .Range("N" & l_info)
                'formulation
                .FormulaR1C1 = "=IF(RC[-2]<=21,""Faible"",IF(RC[-2]<=43,""Moyenne"",IF(RC[-2]<=64,""Forte"")))"
                'équivaut à un collage spécial valeur
                .Value = .Value
                note_2 = .Value
         End With

        Select Case True
                    Case note_1 = "Mauvais" And note_2 = "Faible"
                            lanote = "B"
                    Case note_1 = "Mauvais" And note_2 = "Moyenne"
                            lanote = "C"
                    Case note_1 = "Mauvais" And note_2 = "Forte"
                            lanote = "C"

                     Case note_1 = "Usuel" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Usuel" And note_2 = "Moyenne"
                            lanote = "B"
                    Case note_1 = "Usuel" And note_2 = "Forte"
                            lanote = "B"

                     Case note_1 = "Bon" And note_2 = "Faible"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Moyenne"
                            lanote = "A"
                    Case note_1 = "Bon" And note_2 = "Forte"
                            lanote = "A"




        End Select

        .Range("O" & l_info).Value = lanote

Set Ws = ThisWorkbook.Worksheets("Donné équipement")
 l_info = Ws.Cells.Find(ComEQUI.Value, , , xlWhole).Row
       Ws.Range("G" & l_info).Value = lanote

 End With

Me.hide



Unload UserFormpri

End Sub

'saisie des options'


Private Sub OptionButton1_Change()

Dim i As Integer
i = 0
Do Until Frame2.Controls(i).Value
    i = i + 1
Loop
Frame2.Controls("textbox1").Value = i + 1

End Sub
Private Sub OptionButton2_Change()

Dim i As Integer
i = 0
Do Until Frame2.Controls(i).Value
    i = i + 1
Loop
Frame2.Controls("textbox1").Value = i + 1

End Sub
Private Sub OptionButton3_Change()

Dim i As Integer
i = 0
Do Until Frame2.Controls(i).Value
    i = i + 1
Loop
Frame2.Controls("textbox1").Value = i + 1

End Sub

Private Sub OptionButton4_Change()

Dim i As Integer
i = 0
Do Until Frame2.Controls(i).Value
    i = i + 1
Loop
Frame2.Controls("textbox1").Value = i + 1

End Sub

Private Sub OptionButton5_Change()

Dim i As Integer
i = 0
Do Until Frame3.Controls(i).Value
    i = i + 1
Loop
Frame3.Controls("textbox2").Value = i + 1

End Sub
Private Sub OptionButton6_Change()

Dim i As Integer
i = 0
Do Until Frame3.Controls(i).Value
    i = i + 1
Loop
Frame3.Controls("textbox2").Value = i + 1

End Sub
Private Sub OptionButton7_Change()

Dim i As Integer
i = 0
Do Until Frame3.Controls(i).Value
    i = i + 1
Loop
Frame3.Controls("textbox2").Value = i + 1

End Sub

Private Sub OptionButton8_Change()

Dim i As Integer
i = 0
Do Until Frame3.Controls(i).Value
    i = i + 1
Loop
Frame3.Controls("textbox2").Value = i + 1

End Sub

Private Sub OptionButton9_Change()

Dim i As Integer
i = 0
Do Until Frame4.Controls(i).Value
    i = i + 1
Loop
Frame4.Controls("textbox3").Value = i + 1

End Sub
Private Sub OptionButton10_Change()

Dim i As Integer
i = 0
Do Until Frame4.Controls(i).Value
    i = i + 1
Loop
Frame4.Controls("textbox3").Value = i + 1

End Sub
Private Sub OptionButton11_Change()

Dim i As Integer
i = 0
Do Until Frame4.Controls(i).Value
    i = i + 1
Loop
Frame4.Controls("textbox3").Value = i + 1

End Sub
Private Sub OptionButton12_Change()

Dim i As Integer
i = 0
Do Until Frame4.Controls(i).Value
    i = i + 1
Loop
Frame4.Controls("textbox3").Value = i + 1

End Sub
Private Sub OptionButton13_Change()

Dim i As Integer
i = 0
Do Until Frame6.Controls(i).Value
    i = i + 1
Loop
Frame6.Controls("textbox4").Value = i + 1

End Sub
Private Sub OptionButton14_Change()

Dim i As Integer
i = 0
Do Until Frame6.Controls(i).Value
    i = i + 1
Loop
Frame6.Controls("textbox4").Value = i + 1

End Sub
Private Sub OptionButton15_Change()

Dim i As Integer
i = 0
Do Until Frame6.Controls(i).Value
    i = i + 1
Loop
Frame6.Controls("textbox4").Value = i + 1

End Sub
Private Sub OptionButton16_Change()

Dim i As Integer
i = 0
Do Until Frame6.Controls(i).Value
    i = i + 1
Loop
Frame6.Controls("textbox4").Value = i + 1

End Sub
Private Sub OptionButton17_Change()

Dim i As Integer
i = 0
Do Until Frame7.Controls(i).Value
    i = i + 1
Loop
Frame7.Controls("textbox5").Value = i + 1

End Sub
Private Sub OptionButton18_Change()

Dim i As Integer
i = 0
Do Until Frame7.Controls(i).Value
    i = i + 1
Loop
Frame7.Controls("textbox5").Value = i + 1

End Sub
Private Sub OptionButton19_Change()

Dim i As Integer
i = 0
Do Until Frame7.Controls(i).Value
    i = i + 1
Loop
Frame7.Controls("textbox5").Value = i + 1

End Sub
Private Sub OptionButton20_Change()

Dim i As Integer
i = 0
Do Until Frame7.Controls(i).Value
    i = i + 1
Loop
Frame7.Controls("textbox5").Value = i + 1

End Sub
Private Sub OptionButton21_Change()

Dim i As Integer
i = 0
Do Until Frame8.Controls(i).Value
    i = i + 1
Loop
Frame8.Controls("textbox6").Value = i + 1

End Sub
Private Sub OptionButton22_Change()

Dim i As Integer
i = 0
Do Until Frame8.Controls(i).Value
    i = i + 1
Loop
Frame8.Controls("textbox6").Value = i + 1

End Sub
Private Sub OptionButton23_Change()

Dim i As Integer
i = 0
Do Until Frame8.Controls(i).Value
    i = i + 1
Loop
Frame8.Controls("textbox6").Value = i + 1

End Sub
Private Sub OptionButton24_Change()

Dim i As Integer
i = 0
Do Until Frame8.Controls(i).Value
    i = i + 1
Loop
Frame8.Controls("textbox6").Value = i + 1

End Sub
'calcule des notes'
Private Sub CommandButton2_Click()

TextRESUETAT = (CDbl(TextBox1.Value) * CDbl(TextBox2.Value) * CDbl(TextBox3.Value))
TextRESUCRIT = (CDbl(TextBox4.Value) * CDbl(TextBox5.Value) * CDbl(TextBox6.Value))



End Sub

'format date de l'amdec'

Private Sub TextDATEAM_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextDATEAM.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextDATEAM)
If valeur = 2 Or valeur = 5 Then TextDATEAM = TextDATEAM & "/"

End Sub

'format date de mise en service'

Private Sub Textmise_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextMISE.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextMISE)
If valeur = 2 Or valeur = 5 Then TextMISE = TextMISE & "/"

End Sub

'format date fin de vie'

Private Sub Textfinvie_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextFINVIE.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextFINVIE)
If valeur = 2 Or valeur = 5 Then TextFINVIE = TextFINVIE & "/"
End Sub

'format date de mise en service'

Private Sub TextREMPL_Change()
'Code permettant de mettre une date au format 00/00/0000 dans une textbox
Dim valeur As Byte
TextREMPL.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
valeur = Len(TextREMPL)
If valeur = 2 Or valeur = 5 Then TextREMPL = TextREMPL & "/"

End Sub

Private Sub SpinButton21_Change()
    With ActiveSheet
        On Error Resume Next
        If .FilterMode Then .ShowAllData
        On Error GoTo 0
        Range("A7:P7").AutoFilter
        .Range("A7:P" & .Cells(Rows.Count, "E").End(xlUp).Row).AutoFilter Field:=5, Operator:= _
            xlFilterValues, Criteria2:=Array(0, DateValue("01/01/" & SpinButton21.Value))
    End With
End Sub
Public Sub Affiche_tout()
    ActiveSheet.Range("A7:P7").AutoFilter
End Sub

Private Sub SpinButton21_GotFocus()
    With Me.SpinButton21
        .LinkedCell = Range("M2").Address
        .SmallChange = 1
        .Max = 2025
        .Min = 2015
        .PrintObject = False
    End With
End Sub

pouvez vous m'aider sur ce sujet ,je voudrais que la feuille soit protéger en ecriture avec un mot de passe et que lorsque je change la date avec mon spinbutton cela ne me demande pas de "oter la protection"

de plus dans le tableau recap je voudrais que pour le mémé équipement sur l annee 2016 ou 2017 ou 2018 etc.. la note ne soit pas supérieur a l’année 2015ou autre sauf si l’équipement a été change "voir une case que je rajouterai dans mon userform "equipement changement"
cela mettra un message que c'est impossible et donc revient sur l'userform pour re-remplir.

A voir également:

Amelioration vba et protection
Rav endpoint protection ✓ - Forum Antivirus
Erreur 1004 vba ✓ - Forum VB / VBA
Contourner protection drm captvty ✓ - Forum Format et connectique vidéo
Vba ouvrir un fichier excel avec chemin ✓ - Forum VB / VBA
Find vba - Astuces et Solutions

1 réponse

Réponse 1 / 1

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
28 nov. 2016 à 15:01

Bonjour,

exemple:
protection feuil1, mais les objets(controls et autres) ont leurs fonctionalites

Private Sub Workbook_Open()
    Sheets("feuil1").Protect Password:="moi", userinterfaceonly:=True
End Sub

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Rav antivirus

VBA : Range avec références variables..

Anti-virus qui s'installe tout seul...

Rav antivirus trouve un virus mais...

Discussions similaires

Newsletters