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