Merhabalar,
Ekteki İki adet belgeden BDOCUMENT belgesindeki paragraftan rastgele bazı kelimeler ADOCUMENT belgesine alınmıştır. Yapılması istenen şey ADOCUMENT belgesindeki birinci kelimeyi BDOCUMENT belgesinde birinci kelime ile karşılaştır. Eğer aynı kelimeler ise BDOCUMENT deki bu kelimeyi mavi renklendir. Sonra her iki belgede döngü rakamını bir arttırarak ikinci kelimeye geç. Değilse BDOCUMENT deki ikinci kelimeye geç. Yine değilse BDOCUMENT deki üçüncü kelimeye geç. Eşit kelimeyi bulana kadar. Kullandığım kodda ne gibi düzeltmeler yapılabilir. Ayrıca "invalid qualifier" hatasının giderilmesi için yardımlarınızı bekliyorum, teşekkür ederim.
Kullandığım kod çalışması şöyle:
Ekteki İki adet belgeden BDOCUMENT belgesindeki paragraftan rastgele bazı kelimeler ADOCUMENT belgesine alınmıştır. Yapılması istenen şey ADOCUMENT belgesindeki birinci kelimeyi BDOCUMENT belgesinde birinci kelime ile karşılaştır. Eğer aynı kelimeler ise BDOCUMENT deki bu kelimeyi mavi renklendir. Sonra her iki belgede döngü rakamını bir arttırarak ikinci kelimeye geç. Değilse BDOCUMENT deki ikinci kelimeye geç. Yine değilse BDOCUMENT deki üçüncü kelimeye geç. Eşit kelimeyi bulana kadar. Kullandığım kodda ne gibi düzeltmeler yapılabilir. Ayrıca "invalid qualifier" hatasının giderilmesi için yardımlarınızı bekliyorum, teşekkür ederim.
Kullandığım kod çalışması şöyle:
Kod:
Sub RapordanAnabelgeye()
Dim AWords, BWords, i, j, k As Long
Dim MyColl As New Collection
Dim x, y As String
Dim MyArr() As String
'RAPOR ADOCUMENT
ActiveWindow.ActivePane.View.ShowAll = False
Documents("ADOCUMENT.doc").Activate
AWords = ActiveDocument.Words.Count
For i = 1 To AWords
x = Trim(ActiveDocument.Words(i))
MyColl.Add (x)
Next
'ANA BDOCUMENT
On Error Resume Next
Documents("BDOCUMENT.doc").Activate
BWords = ActiveDocument.Words.Count
ReDim MyArr(1 To BWords)
For j = 1 To BWords
y = Trim(ActiveDocument.Words(j))
MyArr.Add (y)
Next
On Error Resume Next
l = 1
For k = 1 To AWords
bas:
If MyColl(k) = MyArr(l) Then
MyArr(k).Font.Color = wdColorBlue
Else
l = l + 1
GoTo bas
End If
l = l + 1
Next
End Sub