besoin d'aide au programmation en vba

progaide

XLDnaute Nouveau
salut
je voudrais savoir es que c'est possible de 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 .
et si c posible comment je peux le faire
merci d'avance
 

Pièces jointes

  • exp.zip
    3.5 KB · Affichages: 44
  • exp.zip
    3.5 KB · Affichages: 48
  • exp.zip
    3.5 KB · Affichages: 47
Dernière édition:

PMO2

XLDnaute Accro
Re : besoin d'aide au programmation en vba

Bonjour,

Une piste avec le code ci-dessous. Je me suis basé sur votre exemple.

Code:
Sub RecupDataBalise()
Dim reponse
Dim A$
Dim DOC As Object 'Word.document
Dim T()
Dim pos&
Dim cpt&
reponse = Application.GetOpenFilename("Documents Word (*.doc), *.doc")
If reponse = False Then Exit Sub
Set DOC = GetObject(reponse)
A$ = DOC.Range.Text
DOC.Close
Set DOC = Nothing
If InStr(1, A$, "[") = 0 Then Exit Sub
Do Until InStr(1, A$, "]") = 0
  pos& = InStr(1, A$, "[")
  A$ = Mid(A$, pos + 1)
  pos& = InStr(1, A$, "]")
  cpt& = cpt& + 1
  ReDim Preserve T(1 To 2, 1 To cpt&)
  T(1, cpt&) = Mid(A$, 1, pos& - 1)
  A$ = Mid(A$, pos& + 1)
  pos& = InStr(1, A$, "[")
  T(2, cpt&) = Trim(Mid(A$, 1, pos& - 1))
  A$ = Mid(A$, pos& + Len(T(1, cpt&)) + 2)
Loop
Sheets.Add
Range(Cells(1, 1), Cells(UBound(T, 2), 2)) = _
    Application.WorksheetFunction.Transpose(T)
End Sub

Cordialement.

PMO
Patrick Morange
 

progaide

XLDnaute Nouveau
Re : besoin d'aide au programmation en vba

salut PMO2 waw:eek: c'est superrr ce programme ça marche très bien mais s'il vous plaiz j'ai pas bien compris le programme je suis debitante en vba vous pouvez s'il vous plaiez m'expliqué un peux le programme.et si je veux préciser le chemain de document comment je peux le faire et merci d'avance je vous souhaite bonne soirée merciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii
 

PMO2

XLDnaute Accro
Re : besoin d'aide au programmation en vba

Bonjour,

et si je veux préciser le chemin du document
Cela se fait automatiquement au sein de la macro par l'instruction
reponse = Application.GetOpenFilename("Documents Word (*.doc), *.doc")
qui monte la boîte de dialogue "Ouvrir" et dans laquelle vous pouvez naviguer.

vous pouvez s'il vous plait m'expliquer un peu le programme
Ci-dessous mon code commenté (n'hésitez pas à l'exécuter en mode pas à pas. Touche F8 dans le VBE (éditeur VBA)).

Code:
Sub RecupDataBalise()
Dim reponse
Dim A$
Dim DOC As Object 'Word.document
Dim T()
Dim pos&
Dim cpt&

'--- Fait apparaître la boite de dialogue "Ouvrir"
'--- et, si vous n'avez pas cliqué sur Annuler ou
'--- sur la Croix de fermeture, met le chemin du
'--- fichier dans la variable "reponse"
reponse = Application.GetOpenFilename("Documents Word (*.doc), *.doc")
If reponse = False Then Exit Sub
'--- Ouvre le fichier Word sans qu'il soit visible
Set DOC = GetObject(reponse)
'--- Récupère tout le texte du fichier dans une variable de type String
A$ = DOC.Range.Text
'--- Ferme le fichier Word
DOC.Close
Set DOC = Nothing
'--- Si il n'y a aucune occurence de "[" alors on quitte la macro
If InStr(1, A$, "[") = 0 Then Exit Sub
'--- On recherche les "[" et les "]" pour définir leurs positions
'--- puis on coupe les sous-chaînes qui nous intéressent
'--- Mettez vous en mode pas à pas (F8) pour surveiller les
'--- valeurs de A$ et de pos&
Do Until InStr(1, A$, "]") = 0
  pos& = InStr(1, A$, "[")
  A$ = Mid(A$, pos + 1)
  pos& = InStr(1, A$, "]")
  cpt& = cpt& + 1
  '--- On met les extractions dans un tableau bidimensionné
  '--- ATTENTION seule la dernière dimension peut être redimensionnée
  ReDim Preserve T(1 To 2, 1 To cpt&)
    '--- Les 00x ---
  T(1, cpt&) = Mid(A$, 1, pos& - 1)
  A$ = Mid(A$, pos& + 1)
  pos& = InStr(1, A$, "[")
    '--- Le texte qui nous intéresse
  T(2, cpt&) = Trim(Mid(A$, 1, pos& - 1))
  A$ = Mid(A$, pos& + Len(T(1, cpt&)) + 2)
Loop
'--- On a joute une nouvelle feuille
Sheets.Add
'--- On inscrit ce qui a été trouvé dans la nouvelle feuille
'--- après avoir transposé le tableau T
'--- Il y a nécessité de transposer pour obtenir des lignes sur 2 colonnes
'--- et non 2 lignes sur des colonnes
'--- Voir la remarque ci-dessus (ATTENTION seule la dernière dimension peut être redimensionnée)
Range(Cells(1, 1), Cells(UBound(T, 2), 2)) = _
    Application.WorksheetFunction.Transpose(T)
End Sub

Bon courage.

Cordialement.

PMO
Patrick Morange
 

progaide

XLDnaute Nouveau
Re : besoin d'aide au programmation en vba

salut
merci Patrick Morange le code ça marché merci mais j'ai une petite question par exemple si qq1 a modifier ou a tremper et il a saisi [par 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] ,)
je peux pas recuperer dans ce cas correctement mes données j'ai essaier mais le resultat c un melange des données alors comment je peux faire ???
merci d'avance
 
Dernière édition:

Excel-lent

XLDnaute Barbatruc
Re : besoin d'aide au programmation en vba

Bonjour Progaide,

Remplace le code de PMO2 par celui ci-dessous :
(en bleu les modifications faites)

Code:
Sub RecupDataBalise()
Dim reponse
Dim A$
Dim DOC As Object 'Word.document
Dim T()
Dim pos&
Dim cpt&
reponse = Application.GetOpenFilename("Documents Word (*.doc), *.doc")
If reponse = False Then Exit Sub
Set DOC = GetObject(reponse)
A$ = DOC.Range.Text
DOC.Close
Set DOC = Nothing
If InStr(1, A$, "[COLOR="Blue"][U][B][x[/B][/U][/COLOR]") = 0 Then Exit Sub
Do Until InStr(1, A$, "]") = 0
  pos& = InStr(1, A$, "[COLOR="Blue"][U][B][x[/B][/U][/COLOR]")
  A$ = Mid(A$, pos + 1)
  pos& = InStr(1, A$, "]")
  cpt& = cpt& + 1
  ReDim Preserve T(1 To 2, 1 To cpt&)
  T(1, cpt&) = Mid(A$, 1, pos& - 1)
  A$ = Mid(A$, pos& + 1)
  pos& = InStr(1, A$, "[COLOR="Blue"][U][B][x[/B][/U][/COLOR]")
  T(2, cpt&) = Trim(Mid(A$, 1, pos& - 1))
  A$ = Mid(A$, pos& + Len(T(1, cpt&)) + 2)
Loop
Sheets.Add
Range(Cells(1, 1), Cells(UBound(T, 2), 2)) = _
    Application.WorksheetFunction.Transpose(T)
End Sub

Testé, elle gère bien les petits pièges que tu as glissé dans le texte!

Bonne soirée
 

Excel-lent

XLDnaute Barbatruc
Re : besoin d'aide au programmation en vba

Bonsoir,

Progaide à dit:
mais un petite question vous pouvez m'explique q ce que vous avez fait et pour quoi les [x et si il y a un atre document qui a des
[y001] et [y001] alors il aurra tjr un problème??


Plus de détails :

* L'ancienne macro cherchait tous les "[", notait leurs positions ...

* La nouvelle macro cherche tous les "[x", note leurs positions ...
Ainsi lorsqu'il n'y avait QUE ce signe : [ la macro n'en tient pas compte


Bref, on cherche le point commun entre tes balises, puis on demande à l'ordinateur de les chercher.

Par contre, si tes balises ne sont plus [x000] mais [y000], l'ordinateur ne les verras pas.

Ce qui est normal!

Si tu veux que la macro fonctionne pour tous les cas spécifiques, il faut nous les donner!!!

Au départ, ton premier exemple, tu dis que TOUTES tes balises sont ainsi faites [ + X + chiffre variable + chiffre variable + chiffre variable + ]

Et dans ton exemple à aucun moment on ne voit le signe [ utilisé!

D'où la proposition de PMO2 correspondant parfaitement à ta demande et fonctionnant à la perfection.

Puis tu nous dis que le signe [ n'est pas utilisé que pour les balises! D'où ma proposition.

Maintenant tu nous annonce que la balise n'est plus :
[ + X + chiffre variable + chiffre variable + chiffre variable + ]
mais :
[ + lettre variable + chiffre variable + chiffre variable + chiffre variable + ]

Tu aurais pu tout nous dire dès le départ!!!

Sacré cachotier! ;)

D'autres détails, avant que l'un des forumeurs planche sur ta question?

Pour ma part, j'ai atteins les limites de mes compétences! Je ne saurais t'aider plus!

Bonne soirée
 
Dernière édition:

progaide

XLDnaute Nouveau
Re : besoin d'aide au programmation en vba

salut d'accord merci comme meme vous m'avez vraiment aider
désole pour ne pas dire tous les detaille des la 1er fois mais moi aussi je le savais pas avant mais selment c dernier jours merci pour vous aide :)
bon week
 
Dernière édition:

progaide

XLDnaute Nouveau
Re : besoin d'aide au programmation en vba

* Soit un code qui détectera tout seul tes balises.( c'est mon besoin )

* Soit la macro demandera à l'utilisateur, en début de procédure, la forme des balises du fichier à extraire, et grâce à ta réponse, le code s'adaptera tout seul!
----------------------------
Par exemple le code pourrait agir ainsi :
-> question utilisateur : "nombre de caractères entre les deux crochets de la balise?"( mais ici il aura un prob car en sais pas les nombre de caractères car par fois en a [x001] ......[x0010])

-> la macro cherchera le caractére [, puis si tu as répondu 5 à la précédente question, il regardera le 6ème caractère, pour voir s'il s'agit du caractére ]

-> ce qui signifiera qu'il s'agit bien d'une balise, et non d'un crochet qui se ballade tout seul!

-> puis le code fera l'extraction.


Envoyé par progaide
je te dis l'objectif de ce programme il doit fonctienner pour too les lettres mais je sais que un documment il contient par exemple des le debut
si le debut [x001] ....[x002]...[x003]... a la fin
si le debut [001]....[002]...[003]....a la fin
sile debut [01]....[02]...[03]...a la fin
sile debut [y01]....[y02]...[y03]...a la fin
les lettres dans un seule document sont les meme.
mais si en va reutiliser le programme pour des autres fichier alors on doit modifier le code alors ça marche pas .
 
Dernière édition:

Discussions similaires

Réponses
7
Affichages
513