Merci Dan,
Pour d'aider a voir la structure de l'application, et de quoi il s'agit, une petite explication.
En Fait j ai constituer une petite base de fichiers, qui servent des formulaires, chaque classeurs contient des fiches formater ou les utilisateur doivent saisir un nombre limité de champs ( des formules predefinies remplissent automatiquement les renseignements necessaires en fonctions des informations fournies )
mon souci au niveau de la securité, c'est que je m adresse a un public pas forcement aleze avec Excel. donc les niveau de securité, les macros , peuvent leurs poser probleme.
ton aide au niveau de certificats m'a selbler pour cela precis mais les fichiers etant deja creer il me faut repasser une a une sur chaque macro.
En ce qui concernent la gestions multifichiers, je souhaitais recuperer facilement les infos contenues dans ces fichiers pour cela je suis en train de reflechir sur un code Vba ( mais je debut donc pas forcement facile ).
Grace a laide du forum, de l aide excel, et de un peu de tamps j ai pu faire le code suivant/
( sans doute pas tres academique ) .
Option Explicit
Sub projet()
Dim s_conso As Workbook
Dim i As Integer
Dim count As Integer
Dim x As Workbook
Set s_conso = ActiveWorkbook
With Application.FileSearch
.NewSearch
.LookIn = s_conso.Path
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
count = 0
For i = 1 To .FoundFiles.count
If .FoundFiles(i) <> s_conso.FullName Then
Set x = Workbooks.Open(.FoundFiles(i), True, , , , , , , , , , , False)
Sheets('1').Activate
Range('C7').Select
Selection.Copy
s_conso.Activate
Sheets('Copie').Activate
Range('A4').Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
x.Activate
Sheets('2').Activate
Range('b23:i175').Select
Selection.Copy
s_conso.Activate
Sheets('Copie').Activate
Range('b4').Select
Selection.Range('a4').PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'recherche 1'
Columns('B:B').Select
Selection.Insert Shift:=xlToRight
Range('B4').Select
ActiveCell.FormulaR1C1 = '=VLOOKUP(RC[-1],'Ref. schap.lib'!R[-2]C[-1]:R[71]C[2],4,0)'
Range('B5').Select
'recherche 2'
Columns('B:B').Select
Selection.Insert Shift:=xlToRight
Range('B4').Select
ActiveCell.FormulaR1C1 = '=VLOOKUP(RC[-1],'Ref. schap.lib'!R[-2]C[-1]:R[71]C[2],3,0)'
Range('B5').Select
'MISE EN FORME'
Columns('E:F').Select
Application.CutCopyMode = False
Selection.Cut
Columns('F:F').Select
Application.CutCopyMode = False
Selection.Cut
Columns('K:K').Select
Selection.Insert Shift:=xlToRight
Columns('A:A').Select
Selection.Copy
Application.CutCopyMode = False
Selection.Cut
Columns('B:B').Select
ActiveSheet.Paste
Columns('f:f').Select
Selection.Delete
Dim y As Variant
Sheets('Copie').Activate
Range('A4').Select
ActiveCell.FormulaR1C1 = _
'=VLOOKUP(RC[1],'Ref. schap.lib'!R[-2]C:R[71]C[4],5,0)'
y = Range('A4').Value
Range('A1') = y
Range('i65536').Select
Selection.End(xlUp).Select
ActiveWindow.ScrollRow = 1
Range(Selection, 'B4').Select
Selection.Copy
Application.Goto reference:=y
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'efface la feuille'
Sheets('Copie').Activate
Cells.Select
Selection.ClearContents
Selection.FormatConditions.Delete
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Range('A1').Select
x.Activate
x.Close SaveChanges:=False
End If
Next i
End With
End Sub
Peut etre cela peut servir de base a qq un.
mais le code est assez lent a s'executer .
voila
encore Merci a Dan pour ces infos
++
shintra
