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 74 75
|
Option Explicit
Sub scanToutesLesInstructions()
' scanne les instructions dans la feuille 2 et les applique
'
Dim l_l_nbLignes, l_l_ligneCur As Long
Dim l_s_adresseModifiee As String
l_l_nbLignes = Sheets("Feuil2").Range("A65536").End(xlUp).Row
'Sheets("Feuil1").Activate
'scan à proprement parler de chaque instruction dans la feuille 1
For l_l_ligneCur = 1 To l_l_nbLignes
'c'est ici que l'instruction est exécutée
l_s_adresseModifiee = DecrypteInstructionVBA(Sheets("Feuil2").Range("A" & l_l_ligneCur).Value)
If l_s_adresseModifiee <> "" Then
'l'exécution était correcte
Else
Sheets("Feuil2").Activate 'debug
Sheets("Feuil2").Range("A" & l_l_ligneCur).Select 'debug
MsgBox "erreur dans l'instruction " _
& Range("Feuil1!A" & l_l_ligneCur) _
& Chr(10) _
& " située à l'adresse : Feuil2!A" & l_l_ligneCur
End If
Next l_l_ligneCur
End Sub
Function DecrypteInstructionVBA(p_s_myInstruction As String) As String
'
'décrypte des instruction du type worksheets("Feuil1").range("A2").value = 12
'
Dim l_s_myAddress As String
Dim l_s_mySheet As String
Dim l_l_posGuillemets1, l_l_posGuillemets2, l_l_posEgal As Long
Dim l_l_valeurAttribuee As Long
'
On Error GoTo Erreur
'p_s_myInstruction = Range(p_s_celluleAnalysee).Value
'récupération du nom de la feuille à modifier
l_l_posGuillemets1 = InStr(1, p_s_myInstruction, """", vbTextCompare)
l_l_posGuillemets2 = InStr(l_l_posGuillemets1 + 1, p_s_myInstruction, """", vbTextCompare)
l_s_mySheet = Mid(p_s_myInstruction, l_l_posGuillemets1 + 1, l_l_posGuillemets2 - l_l_posGuillemets1 - 1)
'récupération de l'adresse à modifier
l_l_posGuillemets1 = InStr(l_l_posGuillemets2 + 1, p_s_myInstruction, """", vbTextCompare)
l_l_posGuillemets2 = InStr(l_l_posGuillemets1 + 1, p_s_myInstruction, """", vbTextCompare)
l_s_myAddress = Mid(p_s_myInstruction, l_l_posGuillemets1 + 1, l_l_posGuillemets2 - l_l_posGuillemets1 - 1)
'récupération de la valeur qui doit ^^etre attribuée à cette adresse
l_l_posEgal = InStr(l_l_posGuillemets2 + 1, p_s_myInstruction, "=", vbTextCompare)
l_l_valeurAttribuee = Val(Right(p_s_myInstruction, Len(p_s_myInstruction) - l_l_posEgal - 1))
'attribution de la valeur à la cellule identifiée par l'adresse
Sheets(l_s_mySheet).Activate 'debug
Sheets(l_s_mySheet).Range(l_s_myAddress).Select 'debug
Sheets(l_s_mySheet).Range(l_s_myAddress).Value = l_l_valeurAttribuee
'valeur retournée par la fonction
DecrypteInstructionVBA = l_s_mySheet & "!" & l_s_myAddress
GoTo Fin
Erreur:
DecrypteInstructionVBA = ""
Fin:
End Function |
Partager