mise à jour fichier

[darib52]

bonsoir,
j'ai demandé la semaine passée s'il existait un prog pour mettre à jour des fichiers excel diffusés un peu partout.
le peu d'enthousiasme rencontré m'a amené à créer une macro qui me permet aujourd'hui de mettre à jour automatiquement les fichiers de mes collègues.
et je vous en fait profiter.
enfin, ceux que ça peut intéresser.

voir la pj.

bonne soirée à tous.
amitiés

 

[darib52]

ça fait plusieurs fois que mon fichier ne part pas.
pourtant .zip et12ko.

Sub Bouton1_QuandClic()
Application.ScreenUpdating = False
Application.Dialogs(xlDialogOpen).Show 'permet le choix du chemin'
Sheets('cession').Select 'choix de la feuille'
ActiveSheet.Unprotect
Range('C127:F127').Select 'génère les modifs dans la feuille'
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Selection.Font.ColorIndex = 3
ActiveCell.FormulaR1C1 = 'FONCTIONNEMENT'
Range('C127:F127').Select
With Selection.Font
.Name = 'Arial'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
Range('F128').Select
ActiveCell.FormulaR1C1 = 'Chapitre'
Range('F128').Select
Selection.Font.Bold = False
With Selection.Font
.Name = 'Arial'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range('H128:I128').Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.NumberFormat = '#,##0.00'
Range('G128').Select
ActiveCell.FormulaR1C1 = '=77'
Range('G128').Select
With Selection.Font
.Name = 'Arial'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range('H128:I128').Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = '=R[-81]C[1]'
Range('H128:I128').Select
With Selection.Font
.Name = 'Arial'
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range('A129').Select
ActiveCell.FormulaR1C1 = 'Chapitre'
Range('B129').Select
ActiveCell.FormulaR1C1 = _
'=if(r[-115]c[6]=''par nature'',''042'',''934'')'
Range('C129129').Select
ActiveCell.FormulaR1C1 = _
'=IF(R[-102]C[4]=''plus-value'',R[-76]C[1]+R[-75]C[1],R[-76]C[1])'
Range('F129').Select
ActiveCell.FormulaR1C1 = 'Chapitre'
Range('G129').Select
ActiveCell.FormulaR1C1 = _
'=IF(RC[1]=0,'''',IF(R[-115]C[1]=''par nature'',IF(RC[1]=0,'''',''042''),''934''))'
Range('H129:I129').Select
ActiveCell.FormulaR1C1 = '=IF(R[-102]C[-1]=''plus-value'',0,R[-75]C[1])'
Range('A130').Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Range('C131:F131').Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Selection.Font.ColorIndex = 3
ActiveCell.FormulaR1C1 = 'INVESTISSEMENT'
Range('A133').Select
ActiveCell.FormulaR1C1 = 'Chapitre'
Range('B133').Select
ActiveCell.FormulaR1C1 = _
'=IF(R[-119]C[6]=''par nature'',''040'',''914'')'
Range('C133133').Select
ActiveCell.FormulaR1C1 = '=IF(R[-106]C[4]=''moins-value'',R[-79]C[1],0)'
Range('F133').Select
ActiveCell.FormulaR1C1 = 'Chapitre'
Range('G133').Select
ActiveCell.FormulaR1C1 = '=IF(R[-119]C[1]=''par nature'',''040'',''914'')'
Range('H133:I133').Select
ActiveCell.FormulaR1C1 = '=IF(R[-106]C[-1]=''moins-value'',RC[-5],0)'
Range('G135').Select
ActiveCell.FormulaR1C1 = '=R[-93]C[1]-R[-93]C[-4]'
Range('G136').Select
ActiveWindow.SmallScroll Down:=12
Range('B138').Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets('Menu').Select
Range('c5').Select
ActiveWorkbook.Save 'sauvegarde du fichier modifié'
ActiveWindow.Close 'fermeture du fichier'
CreateObject('Wscript.shell').Popup 'La mise à jour s'est bien déroulée. Si vous avez diffusé le fichier d'origine, merci de faire suivre cette mise à jour.', 4, 'Ecritures 1-01-06 - Mise à jour n° 1' 'msgbox avec temporisation'
ActiveWorkbook.Close savechanges:=False
Application.Quit
End Sub