Macro qui teste le contenu d'un tableau

Version imprimable

Bonjour,

Etant débutante en vb, j'ai créer une fiche permettant de valider les données dans un tableau afin d'obtenir les données de plusieurs fiches différentes. ci joint la fiche.

J'ai créer des boutons liés par des macros

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
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Sub Transfert()
Dim LigneCible As Long, ligneOrigine As Long
Dim LigneFin As Long
Dim Données As Variant
Dim Nom As String
Dim Mois As String
Dim Trimestre As String
Dim Année As String
Dim Nbjourstrav As String
Dim Nbconges As String
Dim Nbformation As String
Dim Pointeur As Long
Dim CheminBdd As String
'Lecture des infos dans la fiche de saisie
Nom = ThisWorkbook.Worksheets("fiche_activite").Range("B3").Value
Mois = ThisWorkbook.Worksheets("fiche_activite").Range("E3").Value
Trimestre = ThisWorkbook.Worksheets("fiche_activite").Range("E4").Value
Année = ThisWorkbook.Worksheets("fiche_activite").Range("E5").Value
Nbjourstrav = ThisWorkbook.Worksheets("fiche_activite").Range("D6").Value
Nbconges = ThisWorkbook.Worksheets("fiche_activite").Range("D8").Value
Nbformation = ThisWorkbook.Worksheets("fiche_activite").Range("D10").Value
LigneFin = ThisWorkbook.Worksheets("fiche_activite").Range("A2000").End(xlUp).Row
Données = ThisWorkbook.Worksheets("fiche_activite").Range("A14:e" & LigneFin)
 
'Ecriture dans l'onglet Base de données BDD
 
' Le chemin sera à modifier en fonction de l'application
CheminBdd = "u:/test/"
If Left(Dir(CheminBdd & "BDD.*"), 4) <> "BDD." Then
  Workbooks.Add
  Worksheets.Add
  ActiveSheet.Name = "BDD"
  Worksheets("BDD").Range("A1") = "Nom"
  Worksheets("BDD").Range("B1") = "Mois"
  Worksheets("BDD").Range("C1") = "Trimestre"
  Worksheets("BDD").Range("D1") = "Année"
  Worksheets("BDD").Range("E1") = "Nbjourstrav"
  Worksheets("BDD").Range("F1") = "Nbconges"
  Worksheets("BDD").Range("G1") = "Nbformation"
 
  ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
  ActiveWorkbook.SaveAs Filename:=CheminBdd & "BDD.xls"
 Else
  Workbooks.Open Filename:=CheminBdd & "BDD.xls"
End If
LigneCible = Workbooks("BDD.xls").Worksheets("BDD").Range("A65535").End(xlUp).Row + 1
' Boucle répétitive pour le nom
For Pointeur = LigneCible To LigneCible + UBound(Données) - 1
 Range("BDD!A" & Pointeur) = Année
 Range("BDD!B" & Pointeur) = Trimestre
 Range("BDD!C" & Pointeur) = Mois
 Range("BDD!D" & Pointeur) = Nom
 Range("BDD!E" & Pointeur) = Nbjourstrav
 Range("BDD!F" & Pointeur) = Nbconges
 Range("BDD!G" & Pointeur) = Nbformation
Next Pointeur
'Copie globale de la zone saisie
Workbooks("BDD.xls").Worksheets("BDD").Range("H" & LigneCible & ":L" & LigneCible + UBound(Données) - 1) = Données
Workbooks("BDD.xls").Close True
MsgBox "Merci la fiche du mois de " & Range("D3") & " a été transférée à Véronique"
End Sub
 
Sub Transfert_CT()
Dim LigneCible As Long, ligneOrigine As Long
Dim LigneFin As Long
Dim Données As Variant
Dim Nom As String
Dim Mois As String
Dim Trimestre As String
Dim Année As String
Dim Nbjourstrav As String
Dim Nbconges As String
Dim Nbformation As String
Dim Pointeur As Long
Dim CheminBdd As String
'Lecture des infos dans la fiche de saisie
Nom = ThisWorkbook.Worksheets("fiche_activite").Range("B3").Value
Mois = ThisWorkbook.Worksheets("fiche_activite").Range("E3").Value
Trimestre = ThisWorkbook.Worksheets("fiche_activite").Range("E4").Value
Année = ThisWorkbook.Worksheets("fiche_activite").Range("E5").Value
Nbjourstrav = ThisWorkbook.Worksheets("fiche_activite").Range("D6").Value
Nbconges = ThisWorkbook.Worksheets("fiche_activite").Range("D8").Value
Nbformation = ThisWorkbook.Worksheets("fiche_activite").Range("D10").Value
LigneFin = ThisWorkbook.Worksheets("fiche_activite").Range("A2000").End(xlUp).Row
Données = ThisWorkbook.Worksheets("fiche_activite").Range("A14:e" & LigneFin)
 
'Ecriture dans l'onglet Base de données BDD
 
' Le chemin sera à modifier en fonction de l'application
CheminBdd = "u:/"
If Left(Dir(CheminBdd & "BDD.*"), 4) <> "BDD." Then
  Workbooks.Add
  Worksheets.Add
  ActiveSheet.Name = "BDD"
  Worksheets("BDD").Range("A1") = "Nom"
  Worksheets("BDD").Range("B1") = "Mois"
  Worksheets("BDD").Range("C1") = "Trimestre"
  Worksheets("BDD").Range("D1") = "Année"
  Worksheets("BDD").Range("E1") = "Nbjourstrav"
  Worksheets("BDD").Range("F1") = "Nbconges"
  Worksheets("BDD").Range("G1") = "Nbformation"
 
  ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
  ActiveWorkbook.SaveAs Filename:=CheminBdd & "BDD.xls"
 Else
  Workbooks.Open Filename:=CheminBdd & "BDD.xls"
End If
LigneCible = Workbooks("BDD.xls").Worksheets("BDD").Range("A65535").End(xlUp).Row + 1
' Boucle répétitive pour le nom
For Pointeur = LigneCible To LigneCible + UBound(Données) - 1
 Range("BDD!A" & Pointeur) = Année
 Range("BDD!B" & Pointeur) = Trimestre
 Range("BDD!C" & Pointeur) = Mois
 Range("BDD!D" & Pointeur) = Nom
 Range("BDD!E" & Pointeur) = Nbjourstrav
 Range("BDD!F" & Pointeur) = Nbconges
 Range("BDD!G" & Pointeur) = Nbformation
Next Pointeur
'Copie globale de la zone saisie
Workbooks("BDD.xls").Worksheets("BDD").Range("H" & LigneCible & ":L" & LigneCible + UBound(Données) - 1) = Données
Workbooks("BDD.xls").Close True
MsgBox "Merci la fiche du mois de " & Range("D3") & " a été sur votre fichier personnel"
End Sub

Première chose : je ne veux que ces données par mois c'est à dire que la personne saisie chaque mois ces données en tenant compte de changer le mois, comment faire pour vérifier que la personne a bien changé de mois pour valider l'envoi des données.

Deuxième chose : sachant que le champs trimestre découle du mois je souhaite savoir comment dès que la personne change de mois le changement de trimestre se fait automatiquement.

Merci pour vos solutions et explications
vivi

31/08/2011, 21h09
Pierre Fauconnier

Salut.

Le code proposé me semble bien indigeste...

Il me semble qu'il serait utile de repartir "de zéro" et de détailler, d'abord en français, le contexte et l'objetctif...
01/09/2011, 09h58
vivi21

Bonjour Pierre,

Oui le code est peut-être indigeste mais c'est la première fois que je fais du VBA et c'est en récupérant des exemples. Il fonctionne mais ce n'est peut-être pas le top. Je veux bien que vous m'aidiez à repartir à zéro.

Le but est nous souhaitons rassembler les données de chaque personnel dans un tableau excel afin d'en faire les tris croisés que l'on souhaite.

La fiche permet à chaque personnel de remplir son activité mensuelle. A l'aide d'un bouton toute les données de la fiche sont envoyées sur un tableau que la secrétaire exploite. Par contre il faut que chaque personnel puisse voir également sa propre activité (c'est pour cela que j'avais mis un deuxième bouton) Pour éviter que la personne envoi deux fois sont activité mensuelle il faut tester mais cela je n'y arrive pas.

Il me semble que la seul différence entre les 2 procédures, c'est le chemin(si j'en ai loupé, signale-le). Avant d'aller plus loin, il faut rendre ton code lisible. Première étape, mettre tout ce qui est commun dans une seule procédure, et sortir les préfixes répétitifs par des with :

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
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
Sub Transfert()
    call Transfert_Generique("u:/test/")
End Sub
 
Sub Transfert_CT()
    call Transfert_Generique("u:/")
End Sub
 
Sub Transfert_Generique(CheminBdd As String)
 
Dim LigneCible As Long, ligneOrigine As Long
Dim LigneFin As Long
Dim Données As Variant
Dim Nom As String
Dim Mois As String
Dim Trimestre As String
Dim Année As String
Dim Nbjourstrav As String
Dim Nbconges As String
Dim Nbformation As String
Dim Pointeur As Long
'Lecture des infos dans la fiche de saisie
With ThisWorkbook.Worksheets("fiche_activite").
    Nom = .Range("B3").Value
    Mois = .Range("E3").Value
    Trimestre = .Range("E4").Value
    Année = .Range("E5").Value
    Nbjourstrav = .Range("D6").Value
    Nbconges = .Range("D8").Value
    Nbformation = .Range("D10").Value
    LigneFin = .Range("A2000").End(xlUp).Row
    Données = .Range("A14:e" & LigneFin)
End With
 
'Ecriture dans l'onglet Base de données BDD
 
' Le chemin sera à modifier en fonction de l'application
CheminBdd = "u:/"
If Left(Dir(CheminBdd & "BDD.*"), 4) <> "BDD." Then
    Workbooks.Add
    Worksheets.Add
    ActiveSheet.Name = "BDD"
    With Worksheets("BDD")
        .Range("A1") = "Nom"
        .Range("B1") = "Mois"
        .Range("C1") = "Trimestre"
        .Range("D1") = "Année"
        .Range("E1") = "Nbjourstrav"
        .Range("F1") = "Nbconges"
        .Range("G1") = "Nbformation"
    End With
    ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
    ActiveWorkbook.SaveAs Filename:=CheminBdd & "BDD.xls"
Else
    Workbooks.Open Filename:=CheminBdd & "BDD.xls"
End If
LigneCible = Workbooks("BDD.xls").Worksheets("BDD").Range("A65535").End(xlUp).Row + 1
' Boucle répétitive pour le nom
For Pointeur = LigneCible To LigneCible + UBound(Données) - 1
    Range("BDD!A" & Pointeur) = Année
    Range("BDD!B" & Pointeur) = Trimestre
    Range("BDD!C" & Pointeur) = Mois
    Range("BDD!D" & Pointeur) = Nom
    Range("BDD!E" & Pointeur) = Nbjourstrav
    Range("BDD!F" & Pointeur) = Nbconges
    Range("BDD!G" & Pointeur) = Nbformation
Next Pointeur
'Copie globale de la zone saisie
Workbooks("BDD.xls").Worksheets("BDD").Range("H" & LigneCible & ":L" & LigneCible + UBound(Données) - 1) = Données
Workbooks("BDD.xls").Close True
MsgBox "Merci la fiche du mois de " & Range("D3") & " a été sur votre fichier personnel"
End Sub

Au final, on a deux boutons qui génèrent deux états, strictement identiques, avec juste le chemin qui change.

Pour ce qui est de tes changements, je n'ai pas bien compris le numéro 1(cette histoire de controle de mois). Pour le numéro 2, si j'ai bien compris, tu veux que le contenu du trimestre soit forçé par le contenu du mois. Il te faut alors un truc du genre(en supposant que tes mois soient en toutes lettres), juste avant la boucle "for pointeur"

Code:

1
2
3
4
5
6
7
8
9
10
11
 
Select Case Mois
    Case "Janvier", "Février", "Mars"
        Trimestre = "Premier trimestre"
    Case "Avril", "Mai", "Juin"
        Trimestre = "Deuxièmetrimestre"
    Case "Juillet", "Aoüt", "Septembre"
        Trimestre = "Troisième trimestre"
    Case "Octobre", "Novembre", "Décembre"
        Trimestre = "Quatrième trimestre"
End Select

A adapter aux libéllés de mois que tu as réellement et aux libellés de trimestre que tu veux réellement, et sous réserve que j'ai bien compris ce que tu veux faire...

01/09/2011, 21h00
vivi21

MERCI EL_SLAPPER pour ces explications je vais tester tout cela pour le premier controle c'est de vérifier avant d'envoyer dans le fichier bdd.xls que la personne attribuée par le champs "nom" n'est pas déjà envoyé sa fiche pour le mois sélectionné. en fait ne pas envoyé la fiche pour un même mois.
merci de ovtre aide précieuse

vivi
01/09/2011, 21h18
Pierre Fauconnier

Conseils:

Avant de te lancer dans du code, examine ce que tu dois faire. Cela te permettra d'éviter du code en double.

Dans le code que tu as donné, tu as deux fois le même bloc de données, au numéro de ligne près (lignes 33-39 et 49-55 du bloc de code que tu as donné). C'est inutile et difficile à maintenir.

Sépare les actions en petites procédures et fonctions simples à déboguer

Evite les valeurs en dur (les chemins des données, par exemple) et utilise des variables globales. Si le chemin change, tu modifies cela à un seul endroit du code. Mieux encore, tu places le chemin dans une cellule de feuille. De cette manière, tu n'interviens pas sur le code si le chemin vient à être modifié.

Dans un même bloc, tu crées un nouveau classeur ou tu ouvres le classeur s'il existe. Il est préférable d'écrire une fonction qui te renvoie un objet classeur.

Dans ce même bloc, le nouveau classeur est transféré à une personne alors que si le fichier existe, il est enregistré dans le dossier du personnel. Pourtant, il est enregistré au même endroit. il faudrait donc clarifier cela, mais il faudrait aussi sortir l'enregistrement de cette procédure et traiter cette partie du code dans une procédure à part.

Tant pour la lisibilité du code que pour la maintenance, il est préférable de travailler avec des objets que tu as déclaré en utilisant des noms de variables compréhensibles.

En suivant ces conseils, tu auras un code plus clair, plus compréhensible, plus évolutif.

Bonjour ,

la remarque de El Slapper est juste, il faut simplifier les 2 procédures en une seule avec ajout éventuel de paramétre dans l'appel.

Sans regarder le code au complet , j'ai vu quelques erreurs :
Si tu fait un
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Workbooks.Add Worksheets.Add ActiveSheet.name = "BDD" Worksheets("BDD").Range("A1") = "Nom" Worksheets("BDD").Range("B1") = "Mois" Worksheets("BDD").Range("C1") = "Trimestre" Worksheets("BDD").Range("D1") = "Année" Worksheets("BDD").Range("E1") = "Nbjourstrav" Worksheets("BDD").Range("F1") = "Nbconges" Worksheets("BDD").Range("G1") = "Nbformation" ThisWorkbook.Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=Worksheets("BDD").Range("H1:L1")
lorsque tu fais thisworkbook : tu es dans le nouveau fichier créé et l'onglet "fichie_activité" n'existe pas.
Une solution c'est de sauvegarder le nom du fcihier initial avant d'ajouter le ficiher
Code:

1 2 3 4 5 6 Nomfic_initial = activeworkbook.name workbook add ... ... Workbooks (Nomfic_initial ).Worksheets("fiche_activite").Range("A13:E13").Copy Destination:=activeworbook.Worksheets("BDD").Range("H1:L1")
Ensuite , j'ai des doutes sur la syntaxe :
Code:

1 2 Range("BDD!F" & Pointeur)
d'un point de vue général , pourquoi définir comme texte , des valeurs numérique ?
Code:

1 2 3 Dim Nbjourstrav As String Dim Nbconges As String
il faudrait mieux faire
Code:

1 2 3 Dim Nbjourstrav As single dim Nbconges As single
Il faudrait détailler davantage ce que tu veux recopie car avec la boucle pointeur , tu recopies la même ligne..