Re : évolution d'un programme.
Bonsoir, JeanPierre, Tibo, Flop, JNP et les autres.
J'ai eu l'occasion de modifier avec succès un fichier Excel (données et procédures).à l'aide d'un patch.
Merci à tous ceux qui m'ont aidé à le finaliser
Le plus simple est, amha, d'effacer et de recréer la procédure en question
Le code ci-dessous, dont tu pourras t'inspirer, implique que le fichier à modifier soit le seul ouvert, lors de l'ouverture du patch.
Sub RemplaceProcedure()
If ActiveWindow.Caption = "Patch1" Then
ActiveWindow.ActivateNext
End If
EffaceProcedure
AjouteProcedure
End Sub
Public Sub EffaceProcedure()
'variables
Dim VBCodeMod As CodeModule
Dim LigneDebut As Long
Dim NbLignes As Long
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents("Administration").CodeModule
With VBCodeMod
LigneDebut = .ProcStartLine("ValidModifPosition", 0)
NbLignes = .ProcCountLines("ValidModifPosition", 0)
.DeleteLines LigneDebut, NbLignes
End With
End Sub
Public Sub AjouteProcedure()
'variables
Dim VBCodeMod As CodeModule
Dim NbLignes As Long
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents("Administration").CodeModule
With VBCodeMod
NbLignes = .CountOfLines + 1
.InsertLines NbLignes, _
"Private Sub ValidModifPosition()" & Chr(13) & _
"'Variables ***** Début de remplacement *****" & Chr(13) & _
"Dim ValeurCherchée" & Chr(13) & _
"Dim MessageValidModifPos1" & Chr(13) & _
"Dim MessageValidModifPos2" & Chr(13) & _
"ValeurCherchée = [CV13].Value" & Chr(13) & _
"ControleValiditéModifPosition" & Chr(13) & _
"MessageValidModifPos1 = MsgBox(""Voulez-vous réellement modifier cette position ?"", vbInformation + vbYesNo, ""SACA - Paramétrage : Modifier une position existante"")" & Chr(13) & _
"If MessageValidModifPos1 = 7 Then" & Chr(13) & _
"MessageValidModifPos2 = MsgBox("" Opération annulée à votre demande."", vbExclamation, ""SACA - Paramétrage : Valider une modification de position"")" & Chr(13) & _
" MasquAdmin" & Chr(13) & _
"End If" & Chr(13) & _
"If MessageValidModifPos1 = 6 Then" & Chr(13) & _
" Application.ScreenUpdating = False" & Chr(13) & _
" AfficheTout" & Chr(13) & _
" [CV21:EP27].Copy" & Chr(13) & _
" Application.Goto Reference:=[J1], Scroll:=True" & Chr(13) & _
" Cells.Find(What:=ValeurCherchée, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate" & Chr(13) & _
" Selection.PasteSpecial Paste:=xlPasteValues" & Chr(13) & _
" Application.CutCopyMode = False" & Chr(13) & _
"End If" & Chr(13) & _
"EcranModifPosition" & Chr(13) & _
"End Sub" & Chr(13) & _
"'***** Fin de remplacement *****"
End With
End Sub
Cordialement,
Patrick.
