Makro ile Excel üzerinden Worldde tekst bulmak.

[frantic82]

Selam arkadaşlar.
Excel tablom var ve burdan bazı word dosyalarina hyperlink ile bağlantı var.
Fakat yinede açtığım word de ctrl+f yardımı ile arama yapmak zorunda kalıyorum veya aradığım tekst o word dosyasının içinde değilde başka bir dosyada olup uğraştırabiliyor. Acaba Excelden makro ile arama motoru yapıp, kelime yazarak, bir klasörde toplanmış word dosyalarında o kelimeyi arama yapıp bulabilirmiyiz?
Makro dilim ingilizce.
Sorun çok acil.
Şimdiden çok teşekkür ederim.

 

[Husgvarna]

Selam arkadaşlar.
Excel tablom var ve burdan bazı word dosyalarina hyperlink ile bağlantı var.
Fakat yinede açtığım word de ctrl+f yardımı ile arama yapmak zorunda kalıyorum veya aradığım tekst o word dosyasının içinde değilde başka bir dosyada olup uğraştırabiliyor. Acaba Excelden makro ile arama motoru yapıp, kelime yazarak, bir klasörde toplanmış word dosyalarında o kelimeyi arama yapıp bulabilirmiyiz?
Makro dilim ingilizce.
Sorun çok acil.
Şimdiden çok teşekkür ederim.

Merhaba.
Ekte bulunan "DOSYA" adlı klasör ".xls" dosyası yanında olmalıdır.
Word dosyalarınızı "DOSYA" adlı klasör içine kopyalayıp deneyin.

 

[frantic82]

Merhaba.
Ekte bulunan "DOSYA" adlı klasör ".xls" dosyası yanında olmalıdır.
Word dosyalarınızı "DOSYA" adlı klasör içine kopyalayıp deneyin.

Teşekkür ederim ama çalışmadı bende. Mantık olarak doğru ama ben word dosyasının açılıp bulduğu tekst üzerinde seçili yere gitmesini istiyordum.
Birde makroyu göremedim. Kendi sistemime göre düzeltmeler yapmam için nasıl yapıldğına dair kodları görmem gerekiyor. Yinede teşekkürler, güzel çalışma.

 

[Husgvarna]

Teşekkür ederim ama çalışmadı bende. Mantık olarak doğru ama ben word dosyasının açılıp bulduğu tekst üzerinde seçili yere gitmesini istiyordum.

Yukarıdaki dosyayı değiştirdim, onu deneyiniz.
("DOSYA" adlı klasöre 4 adet "word" dosyası eklendi; "Yinede teşekkürler" texti; ikisinde var ikisinde yok; Inputbox'a veriyi eksiksiz giriniz)

Birde makroyu göremedim. Kendi sistemime göre düzeltmeler yapmam için nasıl yapıldğına dair kodları görmem gerekiyor. Yinede teşekkürler, güzel çalışma.

Kodlar "Sayfa1" in kod sayfasında bulunuyor.

 

[frantic82]

Yukarıdaki dosyayı değiştirdim, onu deneyiniz.
("DOSYA" adlı klasöre 4 adet "word" dosyası eklendi; "Yinede teşekkürler" texti; ikisinde var ikisinde yok; Inputbox'a veriyi eksiksiz giriniz)



Kodlar "Sayfa1" in kod sayfasında bulunuyor.

Süpermolmuş kardeşim, ellerine sağlık. Kendim asla halledemezdim.
ARANAN TEXT aaaa.doc da bulundu yazan kodu lazım değil. Onu kaldırsam sorun yaşarmıyım?
Yanlız, tüm word sayfaları aynı anda açılıyorlar , bunu o şekilde değilde , sonraki kelimeyi bul şeklinde NEXT butonu ile yapabilirmiyiz? Windows ara daki gibi.
Fazla şey istedim galiba, şimdiden teşekkür ederim

 

[Husgvarna]

ARANAN TEXT aaaa.doc da bulundu yazan kodu lazım değil. Onu kaldırsam sorun yaşarmıyım?

Sorun olmaz.Şu bölümü silin.

 s = Cells(65000, 1).End(xlUp).Row + 1
 If ad.Selection = A Then Cells(s, 1) = "ARANAN TEXT" & " " & dosya.Name & " " & "da bulundu"

Yanlız, tüm word sayfaları aynı anda açılıyorlar , bunu o şekilde değilde , sonraki kelimeyi bul şeklinde NEXT butonu ile yapabilirmiyiz? Windows ara daki gibi.
Fazla şey istedim galiba, şimdiden teşekkür ederim

Kodları aşağıdakiyle değiştirip deneyiniz. Arama başladığında xls dosyası minimize olacak yanıp sönmeye başlayacak üzerine tek tıklayıp çıkan mesaja
tamam dediğinizde varsa sonrakini arayacaktır.

 Private Sub CommandButton1_Click()
Dim ds, dc, f, s, A
A = InputBox("ARANACAK KELİMEYİ GİRİNİZ.")
If A = Empty Then Exit Sub
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA")
Set dc = f.Files
Application.ScreenUpdating = False
For Each dosya In dc
Set Ad = CreateObject("Word.Application")
On Error Resume Next
 Ad.Documents.Open (ThisWorkbook.Path & "\DOSYA\" & dosya.Name)
 Ad.Visible = True
 Ad.Selection.HomeKey Unit:=wdStory
  Ad.Selection.Find.ClearFormatting
   Ad.Selection.Find.Replacement.ClearFormatting
    With Ad.Selection.Find
        .Text = A
        .Forward = True
        '.Wrap = wdFindContinue
    End With
sss:
Ad.Selection.Find.Execute
Application.WindowState = xlMinimized
If Ad.Selection = A Then
v = v + 1
MsgBox dosya.Name & " da " & v & ". Text bulundu   Sonraki için Tamamı tıklayın"
End If
     If Ad.Selection.Find.Execute = False Then
     GoTo ss
End If
GoTo sss
ss:
 If Ad.Selection <> A Then Ad.Quit
 v = 0
 Next
Application.ScreenUpdating = True
Application.WindowState = xlMinimized
End Sub

 

[frantic82]

Sorun olmaz.Şu bölümü silin.

 s = Cells(65000, 1).End(xlUp).Row + 1
 If ad.Selection = A Then Cells(s, 1) = "ARANAN TEXT" & " " & dosya.Name & " " & "da bulundu"

Kodları aşağıdakiyle değiştirip deneyiniz. Arama başladığında xls dosyası minimize olacak yanıp sönmeye başlayacak üzerine tek tıklayıp çıkan mesaja
tamam dediğinizde varsa sonrakini arayacaktır.

 Private Sub CommandButton1_Click()
Dim ds, dc, f, s, A
A = InputBox("ARANACAK KELİMEYİ GİRİNİZ.")
If A = Empty Then Exit Sub
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path & "\DOSYA")
Set dc = f.Files
Application.ScreenUpdating = False
For Each dosya In dc
Set Ad = CreateObject("Word.Application")
On Error Resume Next
 Ad.Documents.Open (ThisWorkbook.Path & "\DOSYA\" & dosya.Name)
 Ad.Visible = True
 Ad.Selection.HomeKey Unit:=wdStory
  Ad.Selection.Find.ClearFormatting
   Ad.Selection.Find.Replacement.ClearFormatting
    With Ad.Selection.Find
        .Text = A
        .Forward = True
        '.Wrap = wdFindContinue
    End With
sss:
Ad.Selection.Find.Execute
Application.WindowState = xlMinimized
If Ad.Selection = A Then
v = v + 1
MsgBox dosya.Name & " da " & v & ". Text bulundu   Sonraki için Tamamı tıklayın"
End If
     If Ad.Selection.Find.Execute = False Then
     GoTo ss
End If
GoTo sss
ss:
 If Ad.Selection <> A Then Ad.Quit
 v = 0
 Next
Application.ScreenUpdating = True
Application.WindowState = xlMinimized
End Sub

Selamlar yeniden, bugun deneme firsatim oldu yolladiginiz kodlari. Cok tessekkurler yeniden.
Halen bir kac sorunum var, sayilari bulduktan sonra normal tepki verirken, tekst bulunca word kapaniyor. (Tekste rusca katrakterler var. gerci latinde de hata veriyor) (Word dosyasinri sayilar ile adladiridilar) Birde bir sornaki teksti bulmak icin dediginiz gibi okey basinca surekli bir sonraki tekste geciyor. Peki aradigimiz sey ilk bolumde bulununca, cikisi nasil yapacaz acaba?

 

[nisan2]

Selamlar yeniden, bugun deneme firsatim oldu yolladiginiz kodlari. Cok tessekkurler yeniden.
Halen bir kac sorunum var, sayilari bulduktan sonra normal tepki verirken, tekst bulunca word kapaniyor. (Tekste rusca katrakterler var. gerci latinde de hata veriyor) (Word dosyasinri sayilar ile adladiridilar) Birde bir sornaki teksti bulmak icin dediginiz gibi okey basinca surekli bir sonraki tekste geciyor. Peki aradigimiz sey ilk bolumde bulununca, cikisi nasil yapacaz acaba?

Merhaba, benim sorunum da buna benzer fakat benim 2000 kadar dosyam var ve bunların bazılarını birleştirdim. A sütununda dosyaların eski halleri B sütununda ise yeni dosya adları yeralmakta. B sütununda yeni dosyaya köprü kurulmuş durumda. Benim istediğim kelime arama butonunun A hücresinde araması ve tekrar eden dosya adları varsa sırayla veya farklı bir ekranda görüntülemesi. (Kısaca dosyaların hangi dosyalarda birleştiğini görmek istiyorum. ) Şimdiden teşekkür ederim. kelime aramayı bul ile yapıyorum fakat kullanan kişilerin bu kadar bilgisi yok onlara hazır vermek istiyorum.