Système d'archivage excel

Version imprimable

09/01/2011, 00h02
Faradeorn

Système d'archivage excel

Bonjour,

- J'ai une liste d'ouvrages classées selon des critères et j'aimerais pouvoir en archiver certains. Or il se trouve que j'ai 7-8 critères, donc si j'utilise une macro il me faut, pour archiver un des ouvrages, remplir chacun des critères et cela est assez long.

N'y a-t-il pas un moyen que, dès qu'un ou deux critères sont renseignés (l'auteur et le titre de l'ouvrage par exemple), qu'apparaissent à la suite les autres critères (le prix,...)?

Merci à ceux qui me répondront :)
09/01/2011, 08h14
Invité

Bonjour

Ce serait plus simple si tu donnais la structure de ton fichier, comment sont positionnés les différents éléments par rapport aux autres, etc..

Philippe

J'utilise l'archivage à l'aide d'un formulaire situé dans un feuillet "Archivage" et auquel on accède grâce à une macro.
Ensuite après avoir rempli les différents critères un bouton (macro) permet d'afficher les éléments entrés dans un tableau situé dans un autre feuillet "Gestion des stocks".

La macro que j'utilise est la suivante:

Code:

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
Sub Archivage()
'
' Archivage Macro
'
Application.ScreenUpdating = False
 
Sheets("Gestion des stocks").Select
Range("B72").Select
 
Do
    If ActiveCell.Value = "" Then
        ActiveCell.Value = "1"
        GoTo Archivage
    End If
 
    If ActiveCell <> "" Then ActiveCell.Offset(1, 0).Select
 
Loop Until ActiveCell.Value = ""
 
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
 
Archivage:
 
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("F7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("H7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("J7").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("F10").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("H10").Value
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Sheets("Archivage").Range("J10").Value
 
Sheets("Archivage").Select
 
Application.ScreenUpdating = True
 
'
End Sub

2vite les Select, Activate et activecell
ton code sera plus conformiste comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Archivage()
Dim LastLig As Integer
 
Application.ScreenUpdating = False
With Sheets("Gestion des stocks")
   LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
   If LastLig <= 72 Then
      LastLig = 72
      .Range("B" & LastLig).Value = 1
   Else
      .Range("B" & LastLig).Value = .Range("B" & LastLig - 1).Value + 1
   End If
   .Range("C" & LastLig).Value = Sheets("Archivage").Range("F7").Value
   .Range("D" & LastLig).Value = Sheets("Archivage").Range("H7").Value
   .Range("E" & LastLig).Value = Sheets("Archivage").Range("J7").Value
   .Range("F" & LastLig).Value = Sheets("Archivage").Range("F10").Value
   .Range("G" & LastLig).Value = Sheets("Archivage").Range("H10").Value
   .Range("H" & LastLig).Value = Sheets("Archivage").Range("J10").Value
End With
End Sub

09/01/2011, 20h43
Faradeorn

Merci pour la modification du code, mais ca ne répond pas à mon problème de départ, si quelqu'un a une idée?