1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
|
'pour déprotéger le projet d'un classeur
Sub macro1()
Dim classeur2 As String
Dim Wb As Workbook
classeur2 = ActiveWorkbook.Name
Set Wb = Workbooks(classeur2)
UnprotectVBProject Wb, "motdepasse"
MsgBox "déprotection ok"
End Sub
Sub UnprotectVBProject(Wb As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = Wb.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys Password & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub
'pour reprotéger le projet d'un classeur
Sub macro2()
Dim classeur2 As String
Dim Wb As Workbook
classeur2 = ActiveWorkbook.Name
Set Wb = Workbooks(classeur2)
ProtectVBProject Wb, "motdepasse"
MsgBox "protection ok"
End Sub
Sub ProtectVBProject(Wb As Workbook, ByVal Password As String)
Dim vbProj As Object
Set vbProj = Wb.VBProject
If vbProj.Protection = 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
DoEvents
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~"
'SendKeys Password & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
DoEvents
End Sub
'macro à exécuter pendant que le classeur est déprotégé
Sub creationMacroOuverture(cible As String)
Sheets("Stats").Select
Dim a, x As Integer
Dim Nom As String
For a = 1 To ThisWorkbook.VBProject.VBComponents.Count
Nom = ThisWorkbook.VBProject.VBComponents.Item(a).Name
If ThisWorkbook.VBProject.VBComponents.Item(a).Name <> "UserFormListe" Then
ThisWorkbook.VBProject.VBComponents.Item(a).Activate
If ActiveSheet.Name = cible Then Exit For
End If
Next
With ActiveWorkbook.VBProject.VBComponents(a).CodeModule
x = .CountOfLines
.InsertLines x + 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
.InsertLines x + 2, "If Target.Column = 1 And Target.Row > 2 Then"
.InsertLines x + 3, " Dim NuméroAliment As String"
.InsertLines x + 4, " NuméroAliment = Range(Target.Address).Value"
.InsertLines x + 5, " Module2.définitive (NuméroAliment)"
.InsertLines x + 6, "End If"
.InsertLines x + 7, "End Sub"
End With
End Sub |
Partager