Word 2003 VBA problem

Pozdravljeni,

ne spoznam se na macre pa prosim za pomoč

Imam (posnet) macro s katerim hočem iz dokumenta 1 v dokument 2 prekopirati slike glede na odgovarjajoče ime. Torej v dokumentu 2 je ime X in zraven hočem da se prilepi odgovarjajoča slika Y iz dokumenta 1 - takih vrstic je cca 10 - 20

Problem je v Selection.Find funkciji - .Text = " tu notri bi moral zapisati ime iz Selection.Copy dokumenta 2, da ga poišče v dokumentu 1 in od tam skopira odgovarjajočo sliko

Sub Macro12()
'
' Macro12 Macro
' Macro recorded 9/25/2009 by Nikola
'
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Copy
Windows("DOKUMENT 1").Activate
Selection.HomeKey Unit:=wdStory
Selection.PasteAndFormat (wdSingleCellText)
Selection.TypeBackspace
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Copy
Selection.TypeBackspace
Selection.Find.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
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.Copy
Windows("DOKUMENT 2").Activate
Selection.MoveLeft Unit:=wdWord, Count:=1
Selection.PasteAndFormat (wdPasteDefault)
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveLeft Unit:=wdWord, Count:=1
End Sub

Bi mi lahko pomagali ?

Poleg slike v dokumentu 1 imam isto ime X. Torej ročno je videti tako :

kopiram ime X iz dokumenta 2, odprem dokument 1 in s Ctrl+F poiščem ime X in nato kopiram sliko ob imenu X nazaj v dokument 2

Problem je v tem, da Ctrl+F funkcija v macru postane Selection.Find ki pa ima potem vedno isti .Text = " " se pravi najde vedno iste slike

.Text = " tu notri bi morala biti različna imena X " da najde različne slike

Torej ime X1, X2, X3 ... => slike Y1, Y2, Y3 ..
Ta imena X1, X2 ... ne uspem skopirati, vedno samo prvega in potem lepi vse iste slike

če bi uspel dati .Text = Selection.Paste ali kaj podobnega da išče vedno novo ime, pa mi ne dela

Na začetku narediš neko for zanko npr.
for n=1 to ActiveDocument.paragraphs.count
Potem pa daš vsebino odstavka v spremenljivko odstavek = ActiveDocument.Paragraphs(n)
in nato to spremenljivko uporabiš za
With Selection.Find
.Text = odstavek

Edino, kar je problem, je to, da ti v spremenljivko odstavek pobere še CR/LF, ki ga je na koncu treba odrezati.

Se opravičujem za malce pozen odgovor...
Zdaj pa sem se popolnoma izgubil.
Kolikor jaz razumem, imaš sledeče:

Dokument 1:
slika 1
slika 2
slika3

Dokument 2:
slika 1 [dejanska slika1]
slika 2 [dejanska slika2]
slika 3 [dejanska slika3]....

[] v dokumentu 2 predstavlja prave slike, ki jih nato lepiš v dokument 1.
Če je moja logika pravilna, potem ne razumem, zakaj bi želel iskati tisto, kar najdeš?
Narediš for zanko, ki se sprehodi po vseh odstavkih v dokumentu 1

Sub prekopiraj()

    Dim doc1 As Document
    Dim doc2 As Document
    Set doc1 = Documents("1.doc")
    Set doc2 = Documents("2.doc")
    doc1.Activate
    Selection.HomeKey Unit:=wdStory
    
    For n = 1 To doc1.Paragraphs.Count
        para = doc1.Paragraphs(n)
        ' odstrani CR/LF znak
        besedilo = Left(doc1.Paragraphs(n), Len(para) - 1)
        If besedilo <> "" Then
            doc2.Activate
            Selection.HomeKey Unit:=wdStory
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = besedilo
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute
            Selection.MoveDown Unit:=wdLine, Count:=1
            Selection.Copy
            doc1.Activate
            Selection.EndKey Unit:=wdLine
            Selection.PasteAndFormat (wdPasteDefault)
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        End If
    Next n
        
End Sub

Makro se sprehodi po dokumentu 1. Gre v vsak odstavek, kjer prebere besedilo. To besedilo nato poišče v dokumentu 2, ki je sestavljen tako, da ima najprej besedilo, nato pa v drugi vrstici sliko. Ko najde želeno besedilo, se postavi v naslednjo vrstico, označi sliko, gre nazaj v prvi dokument, se postavi na konec vrstice ter tja skopira sliko.

Slike :


iz tega vstavljati v

Najlepše se zahvaljujem "dfajt"-u za zelo dobro delujoč macro !