Copier le Paragraphe donc le si son tableau contien OK dans un fichier

Copier le Paragraphe donc le si son tableau contien OK dans un fichier - VB/VBA/VBS - Programmation

Marsh Posté le 01-10-2009 à 16:19:42    

 
Je suis entrain d'ecrire un programm qui dois recuperer les Paragraphe  
et le copier sur une autre Page word oubien fichier Text.
 
 
 
 
Sub ZelleFinden()
 
 
' Lire les Coordonnees d une table
    Dim myRange As Range
    Dim aDocument As Document
    Dim myZelle As Word.Cell
    Dim actTabelle As Word.Table
    Dim n As Integer
    Dim tableCount As Integer
    Dim myZelle2 As Word.Cell
    Dim wordDoc As Word.Document
   
    'Erzeugt ein neues Dokument mit einer gegebenen Pfad
     
    tableCount = ActiveDocument.Tables.Count
    MsgBox "Anzahl Table= " & tableCount
    For n = 0 To tableCount
    Set actTabelle = ActiveDocument.Tables(1 + n)
       For Each myZelle In ActiveDocument.Tables(1 + n).Range.Cells
       'For Each myZelle In actTabelle.Range.Cells
        If InStr(1, myZelle.Range.Text, "i.O.", vbTextCompare) > 0 Then
        ' aller a la ligne suivante
         MsgBox "ZAHLLLL " & actTabelle.Rows.Count
    MsgBox "Es handelt sich um Zelle: " & myZelle.RowIndex & ", " & myZelle.ColumnIndex
         
        'MsgBox myZelle(3, 12)
         
        'If InStr(1, myZelle.Range.Text, "X", vbTextCompare) > 0 Then
        For j = 1 To actTabelle.Rows.Count
         
       Set myZelle2 = actTabelle.Cell(myZelle.RowIndex + j, myZelle.ColumnIndex)
 
       MsgBox " next value " & myZelle.RowIndex + j & ", " & myZelle.ColumnIndex
         
       
       ' Hier wird der String X gesucht
       
       
       If InStr(1, myZelle2.Range.Text, "X", vbTextCompare) > 0 Then
       
       
         MsgBox "JAJAJAJAJA" & myZelle2.Range.Text
       
     '-----------------------------
     
     
    'Cherche le texte et le selectionne
     
    With Selection.Find
      '  .ClearFormatting
        .Text = myZelle2.Range.Text
       .Execute Forward:=True
   End With
   
   'Recuper le numéro de VRAI paragraphe word
   NumParag = ActiveDocument.Range(Start:=1, End:=Selection.End).Paragraphs.Count
   
   'Recupere le texte complet du paragraphe
   Parag = ActiveDocument.Paragraphs(NumParag).Range
   'Regarde le premier caractere du paragraphe
   NParag = Left(Parag, 1)
   
   'Tant que le premier caractere n'est pas numérique (gestion du TAB avec le Chr(9)) il remonte les paragraphes
   
   Do While IsNumeric(NParag) = False
       NumParag = NumParag - 1
       Parag = ActiveDocument.Paragraphs(NumParag).Range
       NParag = Left(Parag, 1)
       TabParag = Asc(Left(Parag, 1))
       If TabParag = 9 Then NParag = Left(Right(Parag, Len(Parag) - 1), 1)
   Loop
   
   'Une fois trouvé un numéro en debut de paragraphe précédent il le selectionne.
   ActiveDocument.Paragraphs(NumParag).Range.Select
 
   '--------------------
       
      ' Hier wird Der Datei geschrieben
 
      'Inhalt = "Text1" & vbCrLf & "Text2"
      Open "C:\Documents and Settings\TFCECH\Desktop\Makro_erstellen\text.txt" For Output As #1
      Print #1, Parag
      Close
                 
       ' recherche du string "X" if on trouve le string X on va la recuperer
       ' Coordonee(i,j)
                   
        'Resultat = Range("myZelle.RowIndex + 1 & ", " & myZelle.ColumnIndex" ).Value
        End If
        Next j
       
       'Kill Parag
         
        End If
       
     
    Next myZelle
   
Next n
 
End Sub

Reply

Marsh Posté le 01-10-2009 à 16:19:42   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed