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
71
72
73
| Option Explicit
' VBE menu "Tools" > "Reference"
' [x] Microsoft Visual Basic for Applications Extensibility
Public Const rowFormula = 2, colFormula = 2
Public Const nameModule = "ModFonction"
Public Const strSubAfter = "ToDoAfterPatch"
Sub PatchModFonction()
Const delayBeforeContinue = 1 'seconde
Dim vbCmpMod As VBIDE.VBComponent
Dim strCode As String, arrCode As Variant, varLine As Variant
On Error Resume Next
Set vbCmpMod = ThisWorkbook.VBProject.VBComponents(nameModule)
On Error GoTo 0
If vbCmpMod Is Nothing Then Stop: End ' nameModule not found
Application.Calculation = xlCalculationManual
arrCode = Array( _
"Option Explicit ' Patched on " + Format(Date) + " " + Format(Time), _
"", _
"Function EcartEnergie(Energie As Single, D As Single, e As Single)", _
" EcartEnergie=" & Replace97(Cells(rowFormula, colFormula), ",", "."), _
"End Function")
strCode = "" ' Sniffer of formula converted in VBA function
For Each varLine In arrCode: strCode = strCode + varLine + vbCrLf: Next
With vbCmpMod.CodeModule
.DeleteLines 1, .CountOfLines
.InsertLines 1, strCode
End With
CloseAllCodeWindows
Application.OnTime Now + TimeSerial(0, 0, delayBeforeContinue), strSubAfter, , True
End Sub
Function Replace97(ByVal strWhere As String, ByVal strWhat As String, ByVal strBy As String) As String
Dim indChar As Integer, lenWhat As Integer, lenBy As Integer, strResult As String
strResult = strWhere: lenWhat = Len(strWhat): lenBy = Len(strBy)
indChar = InStr(strResult, strWhat)
While indChar > 0
If indChar > 1 Then
strResult = Left(strResult, indChar - 1) + strBy + Mid(strResult, indChar + lenWhat)
Else
strResult = strBy + Mid(strResult, indChar + lenWhat)
End If
indChar = InStr(indChar + lenBy, strResult, strWhat)
Wend
Replace97 = strResult
End Function
Sub CloseAllCodeWindows()
Dim nbrWindow As Integer
On Error Resume Next
With Application.VBE.ActiveCodePane.Collection
nbrWindow = .Count
If Err.Number <> 0 Then nbrWindow = 0
While nbrWindow > 0
.Item(1).Window.Close
If Err.Number <> 0 Then nbrWindow = 0
nbrWindow = nbrWindow - 1
Wend
End With
On Error GoTo 0
End Sub
Sub ToDoAfterPatch()
Application.ScreenUpdating = False
Debug.Print "The patch of " + nameModule + " is done."
Debug.Print "You can access classically to the sheet."
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub |
