Macro spécifique de remplissage de cellule

itigiel Messages postés 7 Statut Membre -  
itigiel Messages postés 7 Statut Membre -
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 Messages postés 7 Statut Membre
     
    Bonjour,
    Je me permet de relancer mon appel à l'aide.
    Merci par avance.
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      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 Messages postés 7 Statut Membre
     
    Ok pas de problème.
    Je fait cela tout de suite.
    Merci
    0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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 Messages postés 7 Statut Membre
       
      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 Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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

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

    Posez votre question
  6. itigiel Messages postés 7 Statut Membre
     
    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 Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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 Messages postés 7 Statut Membre
       
      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 -
francois -

14 réponses
Problème de restrictions
SuperAmbi -
Pat -

5 réponses