• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücre verisine göre word dosyası açma

A

acemi1985

Katılım
15 Kasım 2017
Mesajlar
47
Excel Vers. ve Dili
Excel 2013
Benimde bir sorum olacaktı.
Biz çalışmalarımızda 2017.1 araç arızaları,2017.2 klima arızaları gb. word dosyalarına isimler veriyoruz ortak ağda 2017 adlı bir klasörde.Bende excelde bunları A sütununa 2017.1,2017.2 ... olarak listeliyorum word başlığının başındaki 2017.1, 2017.2 .. gb verdiğimiz numara hep sabit kalıyor ancak yanındaki açıklamalar (araç arızaları,klima arızaları) değişebiliyor.
Köprü kurduğum zaman sürekli bozuluyor mecburen yeniden uğraşıyorum.sadece dosya isiminin verdiğimiz numaraya göre köprü kurabilirmiyim çünkü başlığın sonu değişebiliyor.
Başka bir açıdan örnek vermek gerekirse 2017 klasöründe arama yapmak istediğimizde sağ üst köşede arama yerine "2017.1" yazdığımda sadece o dosyayı getiriyor. 2017.11 veya 2017.100 başlığındaki dosyaları filtrelemiyor.
Bu dosyaları bu şekilde açma şansım var mı Ustalar.
 
Son düzenleme:
Örnek dosyalar ve ana dosyayı paylaşmadığınız sürece cevap bulamayabilirsiniz.

dosya.tc en örnek dosyaları yükleyebilir siniz.
 
Sayın asri iş yerinde maalesef o şansım yok :(
Benim demek istediğim bir klasör düşünün adı 2017
içinde
word dosyası var başlığı 2017.1 klima arızaları
sonra bu başlık 2017.1 klima arızaları-kapatıldı yada yenilendi yada ... gb değişiyor.bunun gb binden fazla word dosyası var yazışma yapılan.
bende excelde bunların değişmeyen tek yeri olan 2017.1,2017.2 gb kodlarını A sütununda listeliyorum B-C-D sütunlarında farklı verileri oluyor. sadece a sütunundaki veriye bağlı olarak word dosyasını açabilirmiyim.
Yada Hani Bilgisayarda klasör içinde arama yapmak için sağ üst köşede dosya ismini arattığımız yer var oraya hücredeki değerini tırnak içinde yazdırsak bile yetecek bana.
 
Son düzenleme:
acemi1985' Alıntı:
word dosyası var başlığı 2017.1 klima arızaları
sonra bu başlık 2017.1 klima arızaları-kapatıldı yada yenilendi yada ...
Genişletmek için tıkla ...

Bu cümleden anladığım kadarı ile 2017.1 ile başlayan iki veya daha fazla dosya var.

Bu durumda A1 de 2017.1 yazdığında hangi dosyaya link verilecek. Hangi dosya açılacak.
 
Pardon Yukarıdaki mesajı düzelttim.
2017.1 dosyası bir tane başlığı sürekli değişiyor ama başlıkta değişmeyen tek yer 2017.1. Yani başlığın başı hep sabit kalıyor 2017.1 klima arızası başlığı daha sonra 2017.1 klıma arızası kapandı olarak değişebiliyor dosya aynı dosya.
 
Sayın Üstadlarım şansım yok mu bu konuda :(
Artık çıldıracağım kaç gündür bununla uğraşıyorum hafta sonu bile uğraşmaya geldim. :)
 
referanslar
Microsoft Word 12.0 Object Library

olmalı


Sayfanın kod bölümüne kodu kopyala sonra a2-a50 arası hücrelerden birine mause ile çift tıkla
not:B sutununa gerek kalmıyor.

Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


If Intersect(Target, [[COLOR="Red"]a2:a50[/COLOR]]) Is Nothing Then Exit Sub

Dim objWord As Word.Application
Dim docWord As Word.Document
Set objWord = CreateObject("Word.Application")

For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files

If IsNumeric(Mid(dosya.Name, Len(Target.Value) + 1, 1)) = False Then
If Target.Value = Mid(dosya.Name, 1, Len(Target.Value)) Then
objWord.Visible = True
yol = dosya
Set docWord = objWord.Documents.Open(Filename:=yol, ReadOnly:=True)

Set docWord = Nothing
Cancel = True
Exit Sub
End If
End If
Next

End Sub
 
Veya bu kodu kullan

Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [[COLOR="Red"]a2:a50[/COLOR]]) Is Nothing Then Exit Sub
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
If IsNumeric(Mid(dosya.Name, Len(Target.Value) + 1, 1)) = False Then
If Target.Value = Mid(dosya.Name, 1, Len(Target.Value)) Then
yol = dosya
CreateObject("Shell.Application").Open (yol)
Cancel = True
Exit Sub
End If
End If
Next
End Sub
 
Teşekkür ederim Halit Bey.
Kodların 2 sinide denedim biraz yavaş çalışıyorlar 3000 dosya var ondan olabilir diye düşünüyorum.Hızlandırma şansımız var mı?
Tekrar Tekrar Teşekkür ederim bu bile rahatlattı beni kafama acayip takmıştım :)
 
Son düzenleme:
Alternatif;

Hız için bu şekilde dener misiniz?
Dosyaların programın çalıştığı klasörde olduğu var sayılmıştır.
B kolonunu kullanmaz, A kolonunda link oluşturur.

Linklenecek verilerin Sayfa1 de A kolonunda olması gerekiyor.

Klasörde 3168 dosya ve linklenecek 4000 hücre için 25 sn sürüyor.
Tabi bu yeterli bir karşılaştırma olmayabilir. Dosyaları ve hücreleri sürekli arda arda kopyaladım.

En doğru hız sonucu sizin denemenizde çıkacaktır.

Kod: 
Sub link_olustur()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   If WorksheetExists("Gecicixxxxx") Then Sheets("Gecicixxxxx").Delete
   Set newsh = Sheets.Add(After:=Sheets(Sheets.Count))
   newsh.Name = "Gecicixxxxx"
    
   Dim myFile
   Dim myDirectory
   Dim counter
   myDirectory = ActiveWorkbook.Path & "\"
   myFile = Dir(myDirectory & "*.*")
   counter = 0
   Sheets("Gecicixxxxx").Columns("A:A").NumberFormat = "@"
   Do While myFile <> ""
      counter = counter + 1
      With myFile
         If InStr(myFile, " ") > 0 Then
           Sheets("Gecicixxxxx").Cells(counter, 1) = Mid(myFile, 1, InStr(myFile, " ") - 1)
           Sheets("Gecicixxxxx").Cells(counter, 2) = myDirectory & myFile
         End If
      End With
      myFile = Dir()
   Loop
   
   Sheets("Sayfa1").Select
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   sonsatir2 = Sheets("Gecicixxxxx").Cells(Rows.Count, "A").End(3).Row
   
   For i = 2 To sonsatir
        aranan = Cells(i, "A").Value
        Set k = Sheets("Gecicixxxxx").Range("A1:A" & sonsatir2).Find(aranan, , xlValues, xlWhole)
        satir = 0
        If k Is Nothing Then
             Cells(i, "A").Hyperlinks.Delete
             Cells(i, "A").Font.Underline = xlUnderlineStyleNone
             Cells(i, "A").Font.ThemeColor = xlThemeColorLight1
             Cells(i, "A").HorizontalAlignment = xlLeft
             Cells(i, "A").VerticalAlignment = xlBottom
        Else
             satir = k.Row
             ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=Sheets("Gecicixxxxx").Cells(satir, "B"), TextToDisplay:=aranan
        End If
   Next i
      
   If WorksheetExists("Gecicixxxxx") Then Sheets("Gecicixxxxx").Delete
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
   On Error GoTo 0
End Function
 
Son düzenleme:
Sayın Asri teşekkür ederim Elinize emeğinize sağlık.
Kodlarınızı denedim klasörde 4000 dosya var 300 satıra köprü oluştururken 3 dk dan fazla sürdü.
Şöyle yapabilir miyiz ben bunu ara ara kullanıp köprüleri yenilemede kullanayım bozulanlar varsa düzeltsin diye.
Ben kayıtlarımı basit bir userform ile yapıyorum bu çalışmayı yada buna benzer bir çalışmayı her bir kayıt için entegre yapabilir miyiz?
 
Sayın Asri;
3000 satır için çalıştırdım makroyu 35 dk bekledim exceli baya kastı bende cntrl+break ile sonlandırdım.
alk klasörleri dikkate alıyor kod belkide o yüzden bunu iptal edebilir miyiz?
 
acemi1985' Alıntı:
Sayın Asri;
3000 satır için çalıştırdım makroyu 35 dk bekledim exceli baya kastı bende cntrl+break ile sonlandırdım.
alk klasörleri dikkate alıyor kod belkide o yüzden bunu iptal edebilir miyiz?
Genişletmek için tıkla ...

Alt klasörleri dikkate almıyor.
Koda Sheets("Sayfa1").Select satırında break point koyun.
dosya listesi hazırlama kaç saniye sürüyor ona bakın.

Daha sonra linkleme ne kadar sürüyor ona bakın.
 
Dosya listeleme 3:01 dk.
link kurma 1:23 dk sürdü.
Yukarıdaki 35 dk'yı lütfen dikkate almayınız bir satırda hata yapmışım onu düzenledim.
Sayın Asri başka birşey yapma, hızlandırma şansımız yok derseniz ben bu kodunuzu çalışmalarıma bir butonla entegre edeceğim kayıtlarımı bitirdikten sonra çalıştırıcağım örneğin 2018.150 den 2018.200 e kadar kayıt yapıp kayıt işim bitince bu makroyu çalıştırıp beklicem.
Teşekkür ederim.Saygılar
 
acemi1985' Alıntı:
Dosya listeleme 3:01 dk.
link kurma 1:23 dk sürdü.
Yukarıdaki 35 dk'yı lütfen dikkate almayınız bir satırda hata yapmışım onu düzenledim.
Sayın Asri başka birşey yapma, hızlandırma şansımız yok derseniz ben bu kodunuzu çalışmalarıma bir butonla entegre edeceğim kayıtlarımı bitirdikten sonra çalıştırıcağım örneğin 2018.150 den 2018.200 e kadar kayıt yapıp kayıt işim bitince bu makroyu çalıştırıp beklicem.
Teşekkür ederim.Saygılar
Genişletmek için tıkla ...

Dosya listelemenin 25-30 saniye sürmesi lazım. 3 dk çok uzun.
 
Walla oturdum kronometreyi çalıştırdım onu bekledim.kırmızı yer sarı olunca durdurdum daha sonrada link için devam ettim.Bence yavaş olması ağdan olabilir bizim iş yeri ortağında word dosyaları.
Sayın Asri ben şimdi bu excele 2017 yılını listeliyorum 2017 klasöründen çekiyorum dosya başlıklarını, yılbaşından sonra 2018 yılını listelicem ve 2018 klasöründen veri çekmek zorunda kalıcam listemdeki 2017 ler tamamen bozulucak.
Bu çalışmayı 2017.1 diyoruz ya orada 2017 klasörüne baksa 2018.1 de ise 2018 e bakma olayı olabilir mi?yada farklı bir çözüm ne önerirsiniz?
 
Son düzenleme:
acemi1985' Alıntı:
Sayın Asri ben şimdi bu excele 2017 yılını listeliyorum 2017 klasöründen çekiyorum dosya başlıklarını, yılbaşından sonra 2018 yılını listelicem ve 2018 klasöründen veri çekmek zorunda kalıcam listemdeki 2017 ler tamamen bozulucak.
Bu çalışmayı 2017.1 diyoruz ya orada 2017 klasörüne baksa 2018.1 de ise 2018 e bakma olayı olabilir mi?yada farklı bir çözüm ne önerirsiniz?
Genişletmek için tıkla ...

Gönderdiğiniz örnek dosyada farklı bir durum göremedim sadece iki kolon var. :)

Program dosya yok ise linkini kaldırıyor var ise ekliyor. Böylece bağlantılar güncel oluyor. Siz 2017 ler kalsın istiyorsanız onları C kolonuna taşıyın o zaman olduğu gibi kalır.
 
Ben onu örnek olarak oluşturduğum için öyle yazdım yoksa 11 kolon liste ben kodlarınızı kendime uyarlıyorum ;) dediğinizi ben yaparım ama arkadaşlarım pek anlamıyorlar bu işleri biz memuruz bugün burada varız yarın yokuz :)
ben ebedi kalacak arkadaşların işlerinide kolaylaştıracak bir çalışma olsun istiyorum, biraz hayır duası alalım değil mi bende siz yardım edenlerde sonuçta devletimiz için faydalı olarak kullanılacak,işler hızlanacak.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst