begin process at 2012 02 13 01:05:36
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBA

 > DEUX MACROS EXCEL : GENERATION DE FEUILLES D'HEURES & RECUPERATION DES DONNÉES DES FEUILLES D'HEURES

DEUX MACROS EXCEL : GENERATION DE FEUILLES D'HEURES & RECUPERATION DES DONNÉES DES FEUILLES D'HEURES


 Information sur la source

Note :
9,67 / 10 - par 3 personnes
9,67 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :VBA Niveau :Débutant Date de création :31/01/2002 Date de mise à jour :06/02/2002 13:41:25 Vu / téléchargé :28 216 / 1 244

Auteur : Cassidy

Ecrire un message privé
Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
La macro1, genere des classeurs Excel avec 52 feuilles d'heures (1 par semaine) et la date de chaque lundi, je vous epargne le code (il est long et c'est principalement de la mise en page).
La macro2 recupere les données des feuilles d'heure et les compile dans un autre classeur Excel (en vue d'être exporter vers une base de donnees).
En gros, si vous voulez en savoir plus vous n'avez qu'a DL le .zip et voir par vous même ce que ça fait.  

Source

  • 'Macro 2 :
  • Sub Compilation()
  • '-----------------------------------------------------------------------------------------
  • 'Déclaration des variables
  • Dim Nom As String
  • Dim NomXLS As String
  • Dim PathC As String
  • Dim PathE As String
  • Dim NomClasseur As String
  • Dim NomClasseurXLS As String
  • Dim NomSem As String
  • Dim Num_affaire As Integer
  • Dim Num_phase As Integer
  • Dim NumSem As Integer
  • Dim Nb_heures As Integer
  • Dim DateJ As Date
  • Dim i As Integer
  • Dim j As Integer
  • Dim k As Integer
  • Dim l As Integer
  • '-----------------------------------------------------------------------------------------
  • 'Initialisation PathC
  • If Cells(4, 2) = "" Then
  • réponse = MsgBox("Emplacement des classeurs manquant", vbExclamation + vbOKOnly, "Attention !!!")
  • Exit Sub
  • End If
  • PathC = Cells(4, 2)
  • 'initialisation NumSem / NomSem
  • If Cells(4, 3) = "" Then
  • réponse = MsgBox("Numero de semaine manquant", vbExclamation + vbOKOnly, "Attention !!!")
  • Exit Sub
  • End If
  • NumSem = Cells(4, 3)
  • NomSem = "semaine" & NumSem
  • 'Initialisation PathE
  • If Cells(8, 2) = "" Then
  • réponse = MsgBox("Emplacement du classeur d'exportation manquant", vbExclamation + vbOKOnly, "Attention !!!")
  • Exit Sub
  • End If
  • PathE = Cells(8, 2)
  • 'Initialisation NomClasseur / NomClasseurXLS
  • If Cells(8, 3) = "" Then
  • réponse = MsgBox("Nom du classeur d'exportation manquant", vbExclamation + vbOKOnly, "Attention !!!")
  • Exit Sub
  • End If
  • NomClasseur = Cells(8, 3)
  • NomClasseurXLS = NomClasseur & ".xls"
  • 'initialisation du compteur de ligne pour le classeur d'exportation
  • l = 2
  • '-----------------------------------------------------------------------------------------
  • 'creation d'une feuille d'exportation (dans un nouveau classeur)
  • Set newBook = Workbooks.Add(xlWBATWorksheet)
  • With newBook
  • .Title = NomClasseur
  • .SaveAs FileName:=PathE & NomClasseur
  • End With
  • Cells(1, 1) = "Nom_Emp"
  • Cells(1, 2) = "DateJ"
  • Cells(1, 3) = "Num_affaire"
  • Cells(1, 4) = "Num_phase"
  • Cells(1, 5) = "Nb_heures"
  • Cells(1, 6) = "Commentaire"
  • '-----------------------------------------------------------------------------------------
  • 'Boucle de traitement des Noms
  • For i = 4 To 54 Step 1
  • Workbooks("Utilitaire.xls").Worksheets("Compilation").Activate
  • 'Condition Nom <> ""
  • If Cells(i, 1) <> "" Then
  • Nom = Cells(i, 1)
  • NomXLS = Nom & ".xls"
  • Workbooks.Open FileName:=PathC & NomXLS
  • Workbooks(NomXLS).Worksheets(NomSem).Activate
  • 'Boucle de balayage des jours
  • DateJ = Cells(1, 5)
  • For j = 5 To 10 Step 1
  • 'Boucle de balayage des projets
  • For k = 4 To 24 Step 1
  • If Cells(k, j) <> "" Then
  • Nb_heures = Cells(k, j)
  • Num_affaire = Cells(k, 1)
  • Num_phase = Cells(k, 2)
  • Workbooks(NomClasseurXLS).Worksheets("feuil1").Activate
  • Cells(l, 1) = Nom
  • Cells(l, 2) = DateJ
  • Cells(l, 3) = Num_affaire
  • Cells(l, 4) = Num_phase
  • Cells(l, 5) = Nb_heures
  • Workbooks(NomXLS).Worksheets(NomSem).Activate
  • 'mise à jour du compteur de ligne pour le classeur d'exportation
  • l = l + 1
  • End If
  • 'Fin de la boucle de balayage des projets
  • Next k
  • 'Fin de la boucle de balayage des jours
  • DateJ = DateAdd("d", 1, DateJ)
  • Next j
  • 'Fin condition Nom <> ""
  • End If
  • 'Fin de la boucle de traitement des noms
  • Next i
  • 'Fermeture et sauvegarde du classeur d'exportation
  • Workbooks(NomClasseurXLS).Worksheets("feuil1").Activate
  • ActiveWorkbook.Close SaveChanges:=True
  • End Sub
'Macro 2 :

Sub Compilation()

'-----------------------------------------------------------------------------------------
'Déclaration des variables
Dim Nom As String
Dim NomXLS As String
Dim PathC As String
Dim PathE As String
Dim NomClasseur As String
Dim NomClasseurXLS As String
Dim NomSem As String
Dim Num_affaire As Integer
Dim Num_phase As Integer
Dim NumSem As Integer
Dim Nb_heures As Integer
Dim DateJ As Date
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

'-----------------------------------------------------------------------------------------
'Initialisation PathC
If Cells(4, 2) = "" Then
réponse = MsgBox("Emplacement des classeurs manquant", vbExclamation + vbOKOnly, "Attention !!!")
Exit Sub
End If
PathC = Cells(4, 2)

'initialisation NumSem / NomSem
If Cells(4, 3) = "" Then
réponse = MsgBox("Numero de semaine manquant", vbExclamation + vbOKOnly, "Attention !!!")
Exit Sub
End If
NumSem = Cells(4, 3)
NomSem = "semaine" & NumSem

'Initialisation PathE
If Cells(8, 2) = "" Then
réponse = MsgBox("Emplacement du classeur d'exportation manquant", vbExclamation + vbOKOnly, "Attention !!!")
Exit Sub
End If
PathE = Cells(8, 2)

'Initialisation NomClasseur / NomClasseurXLS
If Cells(8, 3) = "" Then
réponse = MsgBox("Nom du classeur d'exportation manquant", vbExclamation + vbOKOnly, "Attention !!!")
Exit Sub
End If
NomClasseur = Cells(8, 3)
NomClasseurXLS = NomClasseur & ".xls"

'initialisation du compteur de ligne pour le classeur d'exportation
l = 2

'-----------------------------------------------------------------------------------------
'creation d'une feuille d'exportation (dans un nouveau classeur)
Set newBook = Workbooks.Add(xlWBATWorksheet)
    With newBook
        .Title = NomClasseur
        .SaveAs FileName:=PathE & NomClasseur
    End With
Cells(1, 1) = "Nom_Emp"
Cells(1, 2) = "DateJ"
Cells(1, 3) = "Num_affaire"
Cells(1, 4) = "Num_phase"
Cells(1, 5) = "Nb_heures"
Cells(1, 6) = "Commentaire"

'-----------------------------------------------------------------------------------------
'Boucle de traitement des Noms
For i = 4 To 54 Step 1
Workbooks("Utilitaire.xls").Worksheets("Compilation").Activate
'Condition Nom <> ""
If Cells(i, 1) <> "" Then
Nom = Cells(i, 1)
NomXLS = Nom & ".xls"

Workbooks.Open FileName:=PathC & NomXLS
Workbooks(NomXLS).Worksheets(NomSem).Activate
  
'Boucle de balayage des jours
DateJ = Cells(1, 5)
For j = 5 To 10 Step 1

'Boucle de balayage des projets
For k = 4 To 24 Step 1

If Cells(k, j) <> "" Then
Nb_heures = Cells(k, j)
Num_affaire = Cells(k, 1)
Num_phase = Cells(k, 2)
Workbooks(NomClasseurXLS).Worksheets("feuil1").Activate
Cells(l, 1) = Nom
Cells(l, 2) = DateJ
Cells(l, 3) = Num_affaire
Cells(l, 4) = Num_phase
Cells(l, 5) = Nb_heures
Workbooks(NomXLS).Worksheets(NomSem).Activate
'mise à jour du compteur de ligne pour le classeur d'exportation
l = l + 1
End If

'Fin de la boucle de balayage des projets
Next k

'Fin de la boucle de balayage des jours
DateJ = DateAdd("d", 1, DateJ)
Next j

'Fin condition Nom <> ""
End If

'Fin de la boucle de traitement des noms
Next i


'Fermeture et sauvegarde du classeur d'exportation
Workbooks(NomClasseurXLS).Worksheets("feuil1").Activate
ActiveWorkbook.Close SaveChanges:=True

End Sub   

 Conclusion

Note : j'ai pas pris le temp de faire de gestionnaire d'erreur alors attention avec les champs à renseigner (notamment en ce qui concerne les adresses des dossiers =&gt; assurer vous qu'elles existent)  

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
  • Utilitaire.xlsTélécharger ce fichier [Réservé aux membres club]72 704 octets

Télécharger le zip


 Sources du même auteur

Source avec une capture IMPORTATION DE DONNÉES EXCEL SOUS ACCESS

 Sources de la même categorie

Source avec Zip GESTION PERSONNEL par oudlarbi
Source avec Zip Source avec une capture CALENDRIER EN VBA POUR EXCEL 2010 par nounou94
Source avec Zip Source avec une capture MANIPULER LES FENETRES ENFANT D'EXCEL par bigfish_le vrai
Source avec Zip Source avec une capture COLLECTION ID par Le Pivert
Source avec Zip Source avec une capture VBA MASQUE DE SAISIE NUMÉRIQUE par acive

Commentaires et avis

Commentaire de patoune55 le 03/06/2008 09:58:06 10/10

Bonjour.
Je lance donc le premier commentaire sur cette source de 6ans.

Je suis en stage et mon projet et de créer une base de données avec diverses informations (noms ouvriers, numéro chantier, date, heures, frais déplacement...) pour arriver à un bilan final par chantier....

La macro de création de feuille est tout à fait dans mes besoins, et la compilation permettant de récupérer certains champs aussi (à adapter)

Chaque employé pourra donc créer son classeur en début d'année, et par la compilation je pense pouvoir récupérer tous les champs de chaque classeur pour ainsi construire ma base de données...

Merci d'avoir partagé ton travail

Commentaire de Katourey le 03/11/2008 11:42:50

Très pratique ! Faut-il créer la base de données sous access seulement ?

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,905 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales