Macro spécifique de remplissage de cellule

itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention   -  
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

Etant un pur novice en vba, je bloque allègrement sur une fonctionnalité que je voudrais mettre en place.

Voici mon problème.
Je met en place une procédure pour mon technicien afin qu'il puisse mettre à jour le parc informatique.
Pour se faire, j'ai 2 fichiers excel:
- 1er document: un listing de toutes les machines
- 2eme document: la liste des taches à faire

Une macro est déjà en place pour automatiquement générée ce deuxième fichier depuis le premier (sélection d'un champ suivie d'un clic sur un bouton), personnalisé avec les infos du poste concerné (le document généré porte le nom de l'ordinateur).

Dans ce deuxième fichier, pour chaque tâche, une liste déroulante permet de donner un statuts à cette tâche (non démarré, en attente, terminé).

Ce que je voudrais faire est en théorie simple:
L'évolution des taches du deuxième document doit pouvoir remonter dans le premier, sur la ligne concerner, le pourcentage d'avancement du boulot sur le poste.
Exemple:
Ordinateur SECURITE. La moitié des tâches a le statuts "terminé" dans le 2eme document
Dans le 1er document de listing, une cellule sur le ligne du poste SECURITE affiche 50%.


Le but final est d'avoir une vision rapide de l'avancement du boulot avec une simple lecture du comment listing

Si une âme charitable avait une solution à me proposer, je lui en serais extrêmement reconnaissant.

Merci par avance pour votre aide.

A voir également:

5 réponses

itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,
Je me permet de relancer mon appel à l'aide.
Merci par avance.
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 314
 
Bonjour,

Dans la grande majorité des cas, pas de réponse égale question imprécise ou mal formulée
Au besoin
mettre des extraits des 2 classeurs sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse
0
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Ok pas de problème.
Je fait cela tout de suite.
Merci
0
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Voici le lien vers l'archive avec les 2 documents.

https://www.cjoint.com/?0DDku2RBVDV

Merci par avance.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour tout le monde,
Salut Michel,

Désolé pour l'incruste, j'étais en train de préparer cet exemple.

Je n'ai pas ouvert tes fichiers itigiel.

Bonne continuation à tous les 2.
0
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
C'est presque ça. Comme disait Michel, j'aurais dû mettre mes fichiers dès le début.

En faite, je voulais voir le code de tes macros, mais je n'y arrive pas.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
En faite, je voulais voir le code de tes macros, mais je n'y arrive pas. curieux car elles sont dans le classeur recap.

C'est presque ça. Comme disait Michel, j'aurais dû mettre mes fichiers dès le début. Ben oui. C'est pourquoi ma proposition n'est qu'un exemple d'une façon de faire...
Les codes des deux boutons + 1 fonction :
Private Sub CommandButton1_Click()
'Création des fichiers
Dim xlApp As Excel.Application
Dim xlWbk As Excel.Workbook
Dim Chemin As String
Dim Donnees()
Dim drLig As Long, i As Long

drLig = Columns(3).Find("*", , , , xlByColumns, xlPrevious).Row
Chemin = ThisWorkbook.Path
For i = 5 To drLig
    If UCase(Cells(i, 3)) = "X" Then
        Donnees = Range(Cells(i, 4), Cells(i, 15)).Value
        If FichierExiste(Chemin & "\" & Donnees(1, 1)) = False Then
            Set xlApp = CreateObject("Excel.Application")
            xlApp.Visible = True
            Set xlWbk = xlApp.Workbooks.Add
            With xlWbk.Sheets("Feuil1")
                .Range("A1").Resize(UBound(Donnees, 2), 1) = Application.Transpose(Donnees())
            End With
            xlWbk.SaveAs Chemin & "\" & Donnees(1, 1)
            xlWbk.Close
            xlApp.Quit
        Else
            MsgBox "Le classeur " & Donnees(1, 1) & " existe déjà. Merci de vérifier avant de continuer."
            Exit Sub
        End If
    End If
Next i
Set xlApp = Nothing
Set xlWbk = Nothing
End Sub

Function FichierExiste(NomFichier As String) As Boolean
'test l'existence d'un fichier
FichierExiste = Dir(NomFichier) <> "" And NomFichier <> ""
End Function

Private Sub CommandButton2_Click()
'importe le nombre de taches effectuées
Dim Chemin As String, fichier As String
Dim drLig As Long, i As Long, j As Byte, nbreTachesEffectuees As Integer

drLig = Columns(3).Find("*", , , , xlByColumns, xlPrevious).Row
Chemin = ThisWorkbook.Path & "\"
For i = 5 To drLig
    fichier = Cells(i, 4).Value
    If FichierExiste(Chemin & "\" & Range("D" & i)) = True Then
        ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$B$4:$B$12"
        With Sheets("Feuil2")
            .[A4:A12] = "=Plage"
            For j = 4 To 12
                If UCase(.Range("A" & j).Value) = "X" Then nbreTachesEffectuees = nbreTachesEffectuees + 1
            Next j
            .[A4:A12].ClearContents
        End With
        Sheets("Feuil1").Range("Q" & i) = Round(nbreTachesEffectuees * 100 / CInt(Sheets("Feuil1").Range("P" & i)), 2)
    End If
    nbreTachesEffectuees = 0
Next
End Sub 
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Merci Pijaku.

Voila le code du bouton de mon document:

Sub Macro1()
'
' Macro1 Macro
'
Sheets("Feuil1").Select
ActiveCell.Select
'stokage du nom utilisateur dans la variable utilisateur pour enregistrement
utilisateur = ActiveCell
Selection.Copy
'ouverture classeur To-Do list
Workbooks.Open Filename:="C:\Users\utilisateur\Desktop\Inventaire\To-Do List.xlsx", Editable:=True
Windows("To-Do List.xlsx").Activate
Sheets("Comment utiliser ce modèle").Select
Range("E4").Select
'collage nom utlisateur
ActiveSheet.Paste
'stokage du nom utilisateur dans la variable utilisateur pour enregistrement
utilisateur = ActiveCell
'retour à la feuile liste des taches
Sheets("Liste de tâches").Select
'enregistrement sour nom utilisateur
ActiveWorkbook.SaveAs Filename:="C:\Users\utilisateur\Desktop\Inventaire\" & utilisateur


End Sub


Je vais essayer de transposer ton code dans mes documents.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
1- laisse tomber mon code de création de fichier, cela ne t'aidera pas, mis à part le test de l'existence du fichier...
2- Ta macro peut être remplacée par :
Sub Macro1() 
utilisateur = Sheets("Feuil1").Range("AdresseDeLaCellule").Value
Workbooks.Open Filename:="C:\Users\utilisateur\Desktop\Inventaire\To-Do List.xlsx", Editable:=True
With Woskbooks("To-Do List.xlsx").Sheets("Comment utiliser ce modèle") 
    .Range("E4") = utilisateur
End With 
Sheets("Liste de tâches").Select 
'enregistrement sour nom utilisateur 
ActiveWorkbook.SaveAs Filename:="C:\Users\utilisateur\Desktop\Inventaire\" & utilisateur
End Sub
0
itigiel Messages postés 7 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour à tous,
Je me permet de remonter mon sujet.
Si quelqu'un avait une idée.
Merci par avance
0