Récupérer du texte dans word à coller dans Excel

Version imprimable

Voir 40 message(s) de cette discussion en une page

bonjour,
j'ai besoin d'aide sur macro en vba je suis debutante j'ai essaier de le faire en vba

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test()
Dim Debut as long
Dim Fin as long
 
For i = 1 To ....
Debut = chercher le premier groupe de cellule "[x00" & i & "]"
Fin = chercher le prochain groupe de cellule "[x00" & i & "]"
 
Effacer la partie à droite de debut
Extraire "[x00" & i & "]" et le copier en [A2]
Extraire la partie centrale et le copier en [B2]
 
Next ....
End sub

qq1 peut m'aider svp:roll:

16/01/2009, 16h19
aalex_38

Bonjour,

Peux-tu expliquer ce que tu cherche à faire.

Ici l'explication pour parcourir une plage
16/01/2009, 17h10
progaide

1 pièce(s) jointe(s)

salut d'accord

je voudrais recuperer des données comme ça ( salut les amie[x001]bonjour adan[x001]alors comment ça tu anna[x002]traès bien et vous[x002]..........)dans un document word
et avoir c resultats sur excel

x001|bonjour adan
x002|très bien et vous
.........................
.........................
seulement les données qui sont entre par exemple [x001]....et [x001]

et si je me suis pas bien expliquer vous pouvez trouvez dans la pièces jointes un petit exemple .
merci d'avance

Bon je n'ai pas le temps de tout faire, mais bon déja dans excel tu peux ouvrir ton fichier word avec quelque chose comme ça :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub Ouvreword() Dim Wchemin As String Dim wrdApp As Object Dim wrdDoc As Object On Error GoTo Line1 Wchemin = "...\exp.doc" => ici le chemin complet de ton fichier Set wrdApp = CreateObject("Word.Application") Set wrdDoc = wrdApp.Documents.Open(Wchemin) wrdApp.Visible = True ' Ici le code pour rechercher dans word avec wrdApp. ' Exemple wrdApp.Selection.wholestory pour selectionner toute la page Exit Sub Line1: End Sub
Ensuite dans il te reste à rechercher tes balises dans word et les copier dans excel, utilise l'enregistreur de macro, adapte le code et si tu as test problèmes
tu nous les dis !

16/01/2009, 18h06
progaide

merci
mais je sais faire ça merci qui m'interesse maintenant c'est la macro pour copier les données de word vers excel merci :D
16/01/2009, 18h27
aalex_38

Ok,

Alors c'est simple, sur ta selection dans Word tu fais :

Code:

wrdApp.Selection.Copy

pour copier puis

Code:

ActiveSheet.Paste Destination:=Worksheets("Feuil1").Range("D1")

pour coller.

J'espere que cela peut t'aider
16/01/2009, 18h33
progaide

d'accord mais moi j'ai pas des simple données j'ai des données qui sont entre
[x001] et [x001] par exemple

( salut les amie[x001]bonjour adan[x001]alors comment ça tu anna[x002]très bien et vous[x002]..........)dans le word

et le resultat sur excel
x001|bonjour adan
x002|très bien et vous
.........................
.........................
seulement les données qui sont entre par exemple [x001]....et [x001]

alors c'est très compliqué :(
16/01/2009, 18h37
aalex_38

Bon, peux-tu nous dire ou tu en es exactement et quelles sont les problèmes précis que tu rencontre ainsi ce sera plus facile pour t'aider
16/01/2009, 18h59
progaide

je voudrais savoir es qui il y a un code qui détectera tout seul les balises??
19/01/2009, 11h52
aalex_38

Bonjour,

Pour ce que tu veux faire tu as un exemple ici
19/01/2009, 15h59
progaide

merci j'ai déja vu l'exemple mais moi j'ai des données entre des balises

dans word
[x001]salut ça va [x001]qefdezfe[x002]hjdhahda[x002].....

resultat excel
x001|salut ça va
x002|hjdhahda

Bonjour,

J'ai repris un code fourni par ouskel'n'or je sais plus ou et adapté pour la recherche de balises dans Word, a adapter pour le lancer depuis Excel :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Dim range1 As Range
Dim range2 As Range
 
Selection.HomeKey Unit:=wdStory
Set range2 = Selection.Range
 
    Do While Not Fin
        With Selection
            With .Find
                .Text = "["
                .Execute
                .Forward = True
                Fin = .Found = False
            End With
            .ExtendMode = True
            If Not Fin Then
                With .Find
                    .Text = "]"
                    .Forward = True
                    .Execute
                End With
                Set range1 = Selection.Range
                If range2.Text = range1.Text Then
                    ' Recopie de la balise
                    range2.Copy
                    ' Recopie du texte entre les balises
                    ActiveDocument.Range(Start:=range2.End, End:=range1.Start).Copy
                End If
                Set range2 = range1
 
                .ExtendMode = False
                .MoveRight Unit:=wdWord, Count:=1
            End If
        End With
    Loop

Bon finalement comme j'y suis, voici le code complet qui fait (enfin j'espère ) ce que tu demandes.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub OuvrewordII()
On Error GoTo Line1
 
 
Dim Wchemin As String
Dim wrdApp As Object
Dim wrdDoc As Object
Dim myCell As Range
 
On Error GoTo Line1
 
Wchemin = "..\exp.doc" ' ici entrer le nom du chemin
 
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(Wchemin)
wrdApp.Visible = True ' False pour ne pas afficher le document word
 
Dim range1 As Word.Range
Dim range2 As Word.Range
Dim Maligne As Integer
 
wrdApp.Selection.HomeKey Unit:=wdStory
Set range2 = wrdApp.Selection.Range
 
    Do While Not Fin
        With wrdApp.Selection
            With .Find
                .Text = "["
                .Execute
                .Forward = True
                Fin = .Found = False
            End With
            .ExtendMode = True
            If Not Fin Then
                With .Find
                    .Text = "]"
                    .Forward = True
                    .Execute
                End With
                Set range1 = wrdApp.Selection.Range
                If range2.Text = range1.Text Then
                    Maligne = Maligne + 1
                    Set myCell = Cells(Maligne, 1)
                    ' Recopie de la balise
                    range2.Copy
 
 
                    ActiveSheet.Paste Destination:=Worksheets(ActiveSheet.Name).Range(myCell.Address)
                    ' Recopie du texte entre les balises
                    wrdDoc.Range(Start:=range2.End, End:=range1.Start).Copy
                    ActiveSheet.Paste Destination:=Worksheets(ActiveSheet.Name).Range(myCell.Offset(0, 1).Address)
                End If
                Set range2 = range1
 
                .ExtendMode = False
                .MoveRight Unit:=wdWord, Count:=1
            End If
        End With
    Loop
wrdDoc.Close
 Exit Sub
Line1:
wrdDoc.Close
MsgBox Err.Number & Err.Description
End Sub

Peux-tu à l'avenir nous montrer les morceaux de codes qui posent problèmes, la résolution sera plus facile.

19/01/2009, 17h06
progaide

merci je v essaier le code tout de suit
19/01/2009, 17h18
progaide

merci le code ça marche bien il n y a pas des debogage mais j'ai une petite question s'il vous plaiez si qq1 a saisi [ faute de frape alors es que je vais avoir un problème melange des données dans l'excel
par exemple
[x001]salut tout [ le monde [x001]ça va bjsdhdh[x002]hhhhhhhhhhh[x002]jhdhcd ] zhzdch

????????????????????????????
19/01/2009, 17h49
aalex_38

Fais le test et si tu as des problèmes essais de les résoudre et puis tu dis.
19/01/2009, 18h00
progaide

j'ai fait le test d'un doc word exemple

( Déjà disponible
[x001] sur Playstation 3 et Xbox 360 depuis le 17 octobre dernier. [x001]
Saints [Row 2 s'apprête à débarquer sur PC.
[x002] S'il n'est pas prévu avant le 2 février prochain en Europe [x002], le titre de] Volition / THQ devrait .
[x003] effectivement débouler le 5 janvier chez tous les revendeurs nord-américains [x003]
Des précisions qui concernent la configuration requise] pour faire tourner le bébé , mais également le mode de protection employé par l' éditeur.
[x004] Il s'avère en réalité que Saints Row 2 devrait utiliser la plateforme Steam.[x004]
du coup, il ne sera un e[x ercice à corriger vraisemblablement et une autre eercice pas nécessaire de conserver le DVD dans le lecteur durant une partie.)

le resultats d doc excel

[x001]|sur Playstation 3 et Xbox 360 depuis le 17 octobre dernier
[x003]|effectivement débouler le 5 janvier chez tous les revendeurs nord-
[x004]|Il s'avère en réalité que Saints Row 2 devrait utiliser la plateforme Steam

j'ai un probléme la tague [x002] et pas coller dans le doc excel
alors si un utilisateur fais une faute de saisi d'une [
alors il aura un problème une perte ou melange des données d le doc excel
21/01/2009, 09h41
aalex_38

Ou en es-tu as tu avancé sur le sujet ?

Bon, je n'ai pas de solution toute faite en cas d'erreur de saisie.
Je vois deux pistes, faire une recherche sur "[x" plutôt que sur "[" seul
ou remplacer tous les [ qui ne font pas partie d'une balise par "{" par exemple.
21/01/2009, 10h23
progaide

salut j'ai déjà fais la 1er solution de la recherche avec "[x" aussi avec "[x0" mais ça marche pas avec mon application car je vais pas travailler sur un suel document mais sur plusieures et qui sont different parfois il y un document qui contient "[x001]....[x002]..." un autre qui contient "[y01]...[y02]"....autre qui contient "[01]...[02]".........
je peux pas chonger le document de remplacer les "[ "avec les "{" car j'ai pas le droit de le faire .
le code que tu ma donnée et super je te remercie mais je vais essaier de faire plus des recherches pour avoir une solution de mon problème merci :D

bonne journée
21/01/2009, 10h50
aalex_38

Ok merci pour les explications.

Juste une chose, tu n'as pas le droit de modifier le document word, mais rien ne t'empêche de le recopier par programme dans un autre document.
Mais bon si tes balises changent selon le document ce n'est pas evident d'y appliquer un filtre.
Si quelqu'un a une idée, je laisse la place :-)

Voir 40 message(s) de cette discussion en une page