- Katılım
- 15 Nisan 2007
- Mesajlar
- 3,471
- Excel Vers. ve Dili
- Office 2010 & 2013 tr
Mehaba,
AnaKlasörünüzün yolunu belirleyip kırmızı ile belirttiğim kısmın yerine yazın. Klasör yolunu klasör üzerine gelip sağ tıklayarak özellikler bölümünden öğrenebilirsiniz. Mavi kısma da Anaklasörünüzün adını yazın. Bu kod Thisworkbook bölümünde bulunuyor ve alt klasörlerin isimlerini sayfaya eklediğim comboboxa alıyor.
Aşağıdaki kod da butona bastığınızda çalışır ve combobox da seçili klasörün içinde bulunan wordlerin isimlerini tabloya dönüştürür. Yukarıda kırmızı ve mavi bölümler için söylediğim bu kod için de geçerli. Bu kod module de bulunuyor.
Aşağıdaki kod AnaSayfa'nın kod bölümünde bulunuyor. ve a sütununda çift tıkladığınızda ilgili word dosyasını açıyor. Aynı şekilde kırmızı ve mavi kısma dosya yolunu kopyalamalısınız.
AnaKlasörünüzün yolunu belirleyip kırmızı ile belirttiğim kısmın yerine yazın. Klasör yolunu klasör üzerine gelip sağ tıklayarak özellikler bölümünden öğrenebilirsiniz. Mavi kısma da Anaklasörünüzün adını yazın. Bu kod Thisworkbook bölümünde bulunuyor ve alt klasörlerin isimlerini sayfaya eklediğim comboboxa alıyor.
Kod:
Private Sub Workbook_Open()
Sheets("AnaSayfa").ComboBox1.Clear
Dim ds, f, f1, fc, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("[COLOR="Red"]C:\Users\mustafa\Desktop[/COLOR]\[COLOR="Blue"]Dosyaismi[/COLOR]")
Set fc = f.SubFolders
For Each f1 In fc
Sheets("AnaSayfa").ComboBox1.AddItem f1.Name
Next
End Sub
Kod:
Sub WordAdı()
If Sheets("AnaSayfa").ComboBox1 = "" Then
MsgBox "Klasör ismi seçmediniz."
Exit Sub
End If
[a2:f65536].ClearContents
Range("a2:f65536").Borders.LineStyle = xlNone
Dim MyFolder As String, MyFile As String
Dim i As Long
MyFolder = "[COLOR="Red"]C:\Users\mustafa\Desktop[/COLOR]\[COLOR="Blue"]Dosyaismi[/COLOR]" & "\" & Sheets("AnaSayfa").ComboBox1.Value
MyFile = Dir(MyFolder & Application.PathSeparator & "*.doc", vbDirectory)
Application.DisplayAlerts = False
Do While MyFile <> ""
Cells(i + 2, 2) = MyFile
Cells(i + 2, 2) = Split(Cells(i + 2, 2), ".")
Cells(i + 2, 2).TextToColumns Destination:=Cells(i + 2, 2), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", TrailingMinusNumbers:=True
Cells(i + 2, 1) = i + 1
Range(Cells(i + 2, 1), Cells(i + 2, 6)).Borders.LineStyle = xlContinuous
i = i + 1
MyFile = Dir
Loop
Application.DisplayAlerts = True
End Sub
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a:a]) Is Nothing Or Target = "" Then Exit Sub
Dosya = Target.Offset(0, 1) & "-" & Target.Offset(0, 2) & "-" & Target.Offset(0, 3) _
& "-" & Target.Offset(0, 4) & "-" & Target.Offset(0, 5) & ".Doc"
CreateObject("Shell.Application").Open "[COLOR="Red"]C:\Users\mustafa\Desktop[/COLOR]\[COLOR="Blue"]Dosyaismi[/COLOR]" & "\" & Sheets("AnaSayfa").ComboBox1.Value & "\" & Dosya
End Sub
Comboboxta listelenen klasörlerden istediğinizi seçin ve butona basın.