Macro spécifique de remplissage de cellule

itigiel -  
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.

5 réponses

  1. itigiel Auteur
    Bonjour,
    Je me permet de relancer mon appel à l'aide.
    Merci par avance.
    0
    1. michel_m Contributeur
      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
  2. itigiel Auteur
    Ok pas de problème.
    Je fait cela tout de suite.
    Merci
    0
  3. pijaku Modérateur
    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
    1. itigiel Auteur
      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
  4. pijaku Modérateur
    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
    2. itigiel Auteur
      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
      1. pijaku Modérateur
        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
      2. itigiel Auteur
        Bonjour à tous,
        Je me permet de remonter mon sujet.
        Si quelqu'un avait une idée.
        Merci par avance
        0

    Discussions similaires

    Excel formule : savoir si une cellule contient partie texte
    plunderer007

    14 réponses
    Problème de restrictions
    SuperAmbi

    5 réponses
    Excel ajustement auto taille de la cellule
    Mélanie

    22 réponses