Sujet Précédent Sujet Suivant

Probleme d'indexation de document en VBA sous Word

buzowen Messages postés 4 Date d'inscription jeudi 29 avril 2004 Statut Membre Dernière intervention 13 juin 2007 - 11 juin 2007 à 12:23
buzowen Messages postés 4 Date d'inscription jeudi 29 avril 2004 Statut Membre Dernière intervention 13 juin 2007 - 11 juin 2007 à 12:57
Salut à tous et à toutes!

Voila en fait je dois faire une macro sous word qui me ressort de n'importe quel fichier word un fichier format .txt trier par ordre alphabétique sans doublons et avec tous le mots qui se suivent juste d'un espace. J'ai deja une macro mais elle plante et les résultats sont très aléatoire....
Merci à ceux qui pourront m'aider!!!

2 réponses

Réponse 1 / 2
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
11 juin 2007 à 12:53
Salut,
- Et quelle est la question?

@+: Ju£i?n
Pensez: Réponse acceptée
0
Réponse 2 / 2
buzowen Messages postés 4 Date d'inscription jeudi 29 avril 2004 Statut Membre Dernière intervention 13 juin 2007
11 juin 2007 à 12:57
je te donne le code que j'ai fai teste le et dis moi ce que je pourrais faire pour que l'indexage soit toujours parfait!!

Sub IDX0001()

Call Macro4 ' se place en début de document et insère toto en début de fichier (pour un meilleur tri alphabétique)
Call Macro2 'suppression puces
Call IDX0100 'transforme et enregistre en  .txt
Call IDX0125 'enlève les majuscules pour les mettre en minuscules
Call IDX0120(" n'", " ") 'transforme le premier caractère entre guillemet par le second ici "n'" en espace
Call IDX0120(" s'ils ", " ")
Call IDX0120("s'", " ")
Call IDX0120("c'", " ")
Call IDX0120("l'", "")
Call IDX0120("'", " ")
Call IDX0120(". ", " ")
Call IDX0120("?", " ")
Call IDX0120(",", " ")
Call IDX0120(";", " ")
Call IDX0120(":", " ")
Call IDX0120("/", " ")
Call IDX0120("!", " ")
Call IDX0120("§", " ")
Call IDX0120("<", " ")
Call IDX0120(">", " ")
Call IDX0120("²", " ")
Call IDX0120("&", " ")
Call IDX0120("~", " ")
Call IDX0120("#", " ")
Call IDX0120("{", " ")
Call IDX0120("[", " ")
Call IDX0120("-", " ")
Call IDX0120("|", " ")
Call IDX0120("_", " ")
Call IDX0120("`", " ")
Call IDX0120("", " ")
Call IDX0120("^", " ")
Call IDX0120(")", " ")
Call IDX0120("(", " ")
Call IDX0120("]", " ")
Call IDX0120("=", " ")
Call IDX0120("^", " ")
Call IDX0120("¨", " ")
Call IDX0120("$", " ")
Call IDX0120("¤", " ")
Call IDX0120("*", " ")
Call IDX0120("µ", " ")
Call IDX0120("+", " ")
Call IDX0120("é", "e")
Call IDX0120("è", "e")
Call IDX0120("ê", "e")
Call IDX0120("ë", "e")
Call IDX0120("à", "a")
Call IDX0120("â", "a")
Call IDX0120("ä", "a")
Call IDX0120("î", "i")
Call IDX0120("ï", "i")
Call IDX0120("û", "u")
Call IDX0120("ü", "u")
Call IDX0120("ô", "o")
Call IDX0120(" d'", " ")
Call IDX0120(" l'", " ")
Call IDX0120(" qu'", " ")
Call IDX0120(" les ", " ")
Call IDX0120(" l'", " ")
Call IDX0120(" du ", " ")
Call IDX0120(" elle ", " ")
Call IDX0120(" en ", " ")
Call IDX0120(" le ", " ")
Call IDX0120(" la ", " ")
Call IDX0120(" les ", " ")
Call IDX0120(" un ", " ")
Call IDX0120(" une ", " ")
Call IDX0120(" des ", " ")
Call IDX0120(" je ", " ")
Call IDX0120(" tu ", " ")
Call IDX0120(" il ", " ")
Call IDX0120(" elle ", " ")
Call IDX0120(" nous ", " ")
Call IDX0120(" vous ", " ")
Call IDX0120(" ils ", " ")
Call IDX0120(" elles ", " ")
Call IDX0120(" mon ", " ")
Call IDX0120(" ton ", " ")
Call IDX0120(" son ", " ")
Call IDX0120(" ma ", " ")
Call IDX0120(" ta ", " ")
Call IDX0120(" sa ", " ")
Call IDX0120(" si ", " ")
Call IDX0120(" ne ", " ")
Call IDX0120(" plus ", " ")
Call IDX0120(" dans ", " ")
Call IDX0120(" et ", " ")
Call IDX0120(" qui ", " ")
Call IDX0120(" se ", " ")
Call IDX0120(" de ", " ")
Call IDX0120(" sur ", " ")
Call IDX0120(" est ", " ")
Call IDX0120(" cela ", " ")
Call IDX0120(" pour ", " ")
Call IDX0120(" ça ", " ")
Call IDX0120("""", " ")
Call IDX0120("  ", " ")
Call IDX0120(" 0 ", " ")
Call IDX0120(" 1 ", " ")
Call IDX0120(" 2 ", " ")
Call IDX0120(" 3 ", " ")
Call IDX0120(" 4 ", " ")
Call IDX0120(" 5 ", " ")
Call IDX0120(" 6 ", " ")
Call IDX0120(" 7 ", " ")
Call IDX0120(" 8 ", " ")
Call IDX0120(" 9 ", " ")

Call IDX0130 'conversion texte en tableau
Call IDX0140 'elimination des doublons
Call IDX0150
'Call Macro3 'supprime les paragraphes en espace
Call IDX0100 'enregistre en .txt
Call Macro3 'supprime les paragraphes en espace

Call IDX0100 'enregistre en .txt
'Call Macro6 'supprime toto pour retrouvé le texte initial
Selection.HomeKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    'Selection.Delete Unit:=wdCharacter, Count:=1
   

Call IDX0120("...", " ")
Call IDX0120(" .", " ")
Call IDX0120("  ", " ")
Call IDX0120("   ", " ")
Call IDX0120("    ", " ")
Call IDX0120("     ", " ")
Call IDX0120("      ", " ")
Call IDX0120(" a ", " ")
Call IDX0120(" b ", " ")
Call IDX0120(" c ", " ")
Call IDX0120(" d ", " ")
Call IDX0120(" e ", " ")
Call IDX0120(" f ", " ")
Call IDX0120(" g ", " ")
Call IDX0120(" h ", " ")
Call IDX0120(" i ", " ")
Call IDX0120(" j ", " ")
Call IDX0120(" k ", " ")
Call IDX0120(" l ", " ")
Call IDX0120(" m ", " ")
Call IDX0120(" n ", " ")
Call IDX0120(" o ", " ")
Call IDX0120(" p ", " ")
Call IDX0120(" q ", " ")
Call IDX0120(" r ", " ")
Call IDX0120(" s ", " ")
Call IDX0120(" t ", " ")
Call IDX0120(" u ", " ")
Call IDX0120(" v ", " ")
Call IDX0120(" w ", " ")
Call IDX0120(" x ", " ")
Call IDX0120(" y ", " ")
Call IDX0120(" z ", " ")
Call IDX0100 'enregistre en .txt

End Sub
Sub Macro4()
'
' Macro4 Macro
' Macro enregistrée le 11/06/2007 par gqs
'
    Selection.HomeKey Unit:=wdStory
    Selection.TypeText Text:="toto "
End Sub
Sub Macro2()
'enlève les puces
' Macro2 Macro
' Macro enregistrée le 11/06/2007 par gqs
'
    Selection.WholeStory
    With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = CentimetersToPoints(0.63)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(1.27)
        .TabPosition = CentimetersToPoints(1.27)
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdUndefined
            .Size = wdUndefined
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
        End With
        .LinkedStyle = ""
    End With
    ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
        wdNumberGallery).ListTemplates(1), ContinuePreviousList:=False, ApplyTo:= _
        wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
    Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph
End Sub

Sub IDX0100() '========================= *********** noyeau
'
'Macro qui transforme le fichier Word en fichier text brut
'Puis va sur la macro IDX0001
'
    ChangeFileOpenDirectory "C:\Documents and Settings\gqs\Bureau"
    ActiveDocument.SaveAs FileName:="IDXTemp.txt", _
        FileFormat:=wdFormatText, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
    Documents.Open FileName:="IDXTemp.txt", _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto
    ActiveWindow.Close
    Documents.Open FileName:="IDXTemp.txt", _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto
    'Call IDX0001
End Sub

Sub IDX0120(car As String, car1 As String)

'
'Macro qui supprime les caractères inutile
'

    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = car
        .Replacement.Text = car1
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Sub IDX0130()
'
' essai Macro
' Macro enregistrée le 30/05/2007 par gqs
'
  'conversion texte en tableau debut
 
    Selection.WholeStory
    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=1, _
        NumRows:=1, AutoFitBehavior:=wdAutoFitFixed
        Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
        True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^s"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    'Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^w"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.WholeStory
    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=1, _
        NumRows:=8, AutoFitBehavior:=wdAutoFitFixed
        Selection.Sort ExcludeHeader:=True, FieldNumber:="Colonne 1", _
        SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
        FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByCommas, SortColumn:=False, CaseSensitive:=False, _
        LanguageID:=wdFrench
    Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
        True
   
End Sub
Public Sub IDX0140()   '**************** élimination des doublons *********************
Dim toto As Paragraph
Dim Variable As Integer
Dim old As String

 
  For Each toto In ActiveDocument.Paragraphs
   'Variable = msgbox("old", 16, old)
    'old = Trim$(old)
    'Variable = msgbox("old", 16, old)
    'Variable = Selection.Words(1)
    toto.Range.Select
    If old = Selection.Words(1) Then
            old = Selection.Words(1)
            Selection.Words(1) = ""
            Else: old = Selection.Words(1)
    End If
    'If old = Selection.Words(1) & "s" Then  '** modif mbu ************** suppression des pluriels
    '        old = Selection.Words(1)
    '        Selection.Words(1) = ""
    '       Else: old = Selection.Words(1)
    'End If
Next toto
End Sub

Sub IDX0150()
'
' Macro4 Macro
' Macro enregistrée le 31/05/2007 par gqs
'
   
    'Variable = msgbox("^p", 16, p)
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "   "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "      "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
   
End Sub

'fin macro *********************************

Sub IDX0125()
    'permet de passer en minuscule tous les mots
    Selection.WholeStory
    Dim lclist As String
    Dim wrd As Integer
    Dim sTest As String

    ' list of lowercase words, surrounded by spaces
    'lclist = " of the by to this is from a "

    Selection.Range.Case = wdLowerWord
    'wdTitleWord

    For wrd = 2 To Selection.Range.Words.Count
        sTest = Trim(Selection.Range.Words(wrd))
        sTest = " " & LCase(sTest) & " "
        'If InStr(lclist, sTest) Then
         'Selection.Range.Words(wrd).Case = wdLowerCase
        'End If
    Next wrd
End Sub

Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 11/06/2007 par gqs
'
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
End Sub
0

Discussions similaires

Array Index Out Of Bound Exception
mlahbib -
Julien39 -

5 réponses
Echec:SQLSTATE[HY093]: Invalid parameter number: number...
Leodegard -
f0xi -

1 réponse
Comment faire pour que la cellule n'est pas de couleur?
jack dalton -
jack dalton -

8 réponses
Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Rejoignez-nous