Créer une macro de fichiers word vers excel [résolu]

Y compris Power BI, Power Query et toute autre question en lien avec Excel
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 19 octobre 2017, 11:11

Bon quand je suis dans une phase excel j'en profite pour poser la suite:

Je voudrai déterminer l'évolution du Z score pour chaque personne. Le Z score correspond à l'IMC pondéré par l'âge (selon son âge de la vie l'IMC standard n'est pas le même, comme on peut le voir sur les courbes de poids)

Voilà le fichier source (obtenu grâce à la macro avant):
Tous les dossiers actuels avec IMC anonyme.xlsm
(99.83 Kio) Téléchargé 10 fois
L'IMC d'inclusion est déjà noté

le fichier destination est le suivant:
Essai Z score.xlsx
(383.74 Kio) Téléchargé 12 fois
Je voudrai mettre pour chaque date dans la case bilan n°X, X variant suivant chaque mesure après le bilan d'inclusion.
Pensez vous que ce soit possible de le faire?
Si besoin je peux reposter en tant que nouveau sujet
Merci d'avance! :D
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 20 octobre 2017, 21:46

Salut,

Pou répondre à ta question du 18 Octobre

Il faut dans le code précèdent :
Supprimer cette ligne
    Cells(p, 1).Value = "Dossier N°: " & NumDossier
Modifier cette ligne
   
Cells(p, 2).Value = "Nom et Prénom : " & ID

par
   
Cells(p, 1).Value = "Nom et Prénom : " & ID

Modifier ce bloc :
If LastLigne <> 1 Then
        For i = 1 To UBound(MonTab, 1)
            For j = 1 To UBound(MonTab, 2)
                Sheets(1).Cells(p + i, j).Value = MonTab(i, j)
            Next j
        Next i
        p = p + i
    End If
par ce code
If LastLigne <> 1 Then
        For i = 1 To UBound(MonTab, 1)
            If i = 1 Then
                Sheets(1).Cells(p + i, 1).Value = "N° Dossier"
            Else
                Sheets(1).Cells(p + i, 1).Value = NumDossier
            End If
            For j = 1 To UBound(MonTab, 2)
                Sheets(1).Cells(p + i, j + 1).Value = MonTab(i, j)
            Next j
        Next i
        p = p + i
    End If
En espérant que cela te convienne.
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 23 octobre 2017, 09:35

Merci beaucoup, cela marche parfaitement
Bonne journée! :)
Pour le reste, je repost ca dans un nouveau sujet
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 23 octobre 2017, 12:06

Juste, serait ce possible de faire la même chose pour la première version du document? (avec le tableau simple dans excel)
J'ai essayé de voir si je pouvais pas bidouiller mes les codes me semblent quand même différents, donc je n'y arrive pas trop
Merci!
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 24 octobre 2017, 20:50

Salut Boltu,

Dans ton code :
Tu supprimes
Cells(p, 1).Value = "Dossier N°: " & NumDossier
Tu remplaces
    Cells(p, 2).Value = "Nom et Prénom : " & ID  
par
    Cells(p, 1).Value = "Nom et Prénom : " & ID  
Tu remplaces
For i = 1 To WordDoc.Tables(1).Rows.Count
        p = p + 1
        For j = 1 To WordDoc.Tables(1).Columns.Count
            Valeur = Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(j).Cells(i).Range.Text)
            If j = 1 And Valeur = "" Then
                If Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(2).Cells(i).Range.Text) = "" Then
                    GoTo Suite
                Else
                    Cells(p, j).Value = Valeur
                End If
            Else
                Cells(p, j).Value = Valeur
            End If
        Next j
    Next i
par
For i = 1 To WordDoc.Tables(1).Rows.Count
        p = p + 1
        For j = 1 To WordDoc.Tables(1).Columns.Count
            Valeur = Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(j).Cells(i).Range.Text)
            If j = 1 And Valeur = "" Then
                If Application.WorksheetFunction.Clean(WordDoc.Tables(1).Columns(2).Cells(i).Range.Text) = "" Then
                    GoTo Suite
                Else
                    Cells(p, j + 1).Value = Valeur
                End If
            Else
                Cells(p, j + 1).Value = Valeur
            End If
        Next j
        If i = 1 Then
            Cells(p, 1).Value = "N° Dossier"
        Else
            Cells(p, 1).Value = NumDossier
        End If
    Next i
A+
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 25 octobre 2017, 10:09

Genial parfait, merci beaucoup
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 26 octobre 2017, 10:42

Juste en retravaillant sur le document, je me rends compte que souvent les mois et les jours sont inversés
Ex: 04/08/15 devient 08/04/15
Ce n'est pas gravissime mais serait ce possible de rectifier cela?
Avatar du membre
Jers19
Membre fidèle
Membre fidèle
Messages : 291
Appréciations reçues : 27
Inscrit le : 14 septembre 2017
Version d'Excel : 2010

Message par Jers19 » 26 octobre 2017, 10:45

sur quel fichier (le nouveau ou l'ancien)?
b
boltu
Membre habitué
Membre habitué
Messages : 52
Inscrit le : 24 juillet 2017
Version d'Excel : 2013 FR

Message par boltu » 26 octobre 2017, 11:19

Sur l'ancien
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message