• DİKKAT

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

Userform da ListBox da listeleme ...

D

dragon44760

Katılım
30 Mart 2008
Mesajlar
280
Excel Vers. ve Dili
Microsoft Office Excel 2003, Türkçe
Mevzuatlarla ilgili bir program yapmaya çalışıyorum ama bir yere kadar geldim tıkandım.
Şöyle bir program yapmak istiyorum;

\\Ig060mly03\dosya\BELGELERIM\MEVZUAT
Yukarıda yolunu verdiğim bir ortak kulanımda bulunan "MEVZUAT" klasörü adı altında 8 tane daha klasör var
1. Kanun
2. Kanun Hükmünde Kararname
3. Yönetmelik
4. Bakanlar Kurulu Karararı
5. Tebliğ
6. Genelge
7. Emir
8. Diğer

Türüne göre bu sekiz tane klasörün içine indirdiğim dosyaları kaydediyorum. Örneğin; Kanun klasörü içerisine "6245 Sayılı Harcırah Kanunu.doc" adlı wrod belgesini kaydettim.
Bu kaydettiğim belgenin adını "MEVZUAT PROGRAMI.xls" dosyasına da kaydedeceğim.

"MEVZUAT PROGRAMI.xls" dosyasında bulunan Userfrom da bulunan "Mevzuat Ara" page ile ilgili "OptionButton"u işaretleyerek "ComboBox"a aramak istediğim mevzuatın adını yazıp "Aç" butonu ile açtırmak istiyorum. Sn. Mahmut hocamın yaptığı kod bankasındaki gibi bir ComboBox ve ListBox olmasını istiyorum.

Programımda 9 tane OptionButton var. Bunlar;
1. Tümü
2. Kanun
3. Kanun Hükmünde Kararname
4. Yönetmelik
5. Bakanlar Kurulu Karararı
6. Tebliğ
7. Genelge
8. Emir
9. Diğer

Ben hangi OptionButton'u seçersem ListBox1'e o mevzuat türüyle ilgili kaydettiğim bilgiler gelsin ve yine ListBox2'ye(Özellikle Tümü OptionButton'u seçilince) de mevzuat türünü yazsın istiyorum.

Yine userform da bulunan "Mevzuat Kayıt/Düzeltme" page ile daha önce adını veya mevzuat türünü yanlış kaydetdiğim bir kaydı düzeltebilmek istiyorum.


Bu forumdan öğrendiğim bir şeylerle bir yerlere kadar getirdim ama günlerdir uğraşmama rağmen ilerleme kaydedemiyorum. Yardımcı olursanız sevinirim.
Kolay gelsin...
 

Ekli dosyalar

Arkadaşlar anlayanlar yardımcı olursa sevinirim
 
Ancak Bu Kadar Yapabildim

Biliyorumki çok fazla bir şeyler istedim ama yapabildiklerimi yaptım. Bu halinden daha ileriye götüremedim. Kodlara bakınca belki fazladan işlemleri yaptırdığımı da göreceksiniz.
Bu konuda bana yardımcı olacak olan herkese şimdiden teşekkürler...
 
Arkadaşlar biri bir şeyle söylesin ne olur ya. İstediğim şeylerden yapılamayacaklar mı var_?
 
Bu istediğinizi yapmak için yönetmelik isimlerini excel sayfasına getirmenize bence gerek yok. Benim önerim, seçilen optionbutona ait klasördeki dosyaları bir listboxta listelemek ve bu listboxtan seçilen dosyanında bir butonla yada çift tıklama ile açılmasıdır. Böyle bir çözüm amacınızı karşılarmı?
 
Hata vermekte

Sayın Levent Menteşoğlu ilginize çok teşekkür ederim. Yapmak istediğiniz uygulama benimkine göre daha pratik.

Lakin küçük bir sorun var herhalde, "Path not found" hatası vermekte
Debug dediğimde Class Modules de bulunan kodun şu bölümünü işaret etmekte
"For Each altklasor In CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders"

Eğer mümkünse ekteki mevzuat klasörünü D sürücüne kaydedip gönderdiğim exel sayfasını ona göre düzeltir misiniz_?
 

Ekli dosyalar

Forum sakinleri cevaplarınızı bekliyorum. Emeği geçen herkese şimdiden teşekkürler....
 
dragon44760' Alıntı:
Lakin küçük bir sorun var herhalde, "Path not found" hatası vermekte
Genişletmek için tıkla ...


İlgili klasörü bulamadığı için böyle bir hata mesajı vermiş.
Sizde;
Kod: 
yol = "\\Ig060mly03\dosya\BELGELERIM\MEVZUAT"
satırını
Kod: 
yol = "d:\MEVZUAT"
(sorunuzda belirttiğiniz üzere)şeklinde değiştirmeniz gerekiyor.
Kısaca mevzuat klasörünün olduğu konumu "yol" değişkenine doğru tanımlatmanız gerekiyor.
 
Hocam şu anki kullandığım bilgisayarda bulunan "E" sürücüsü olarak değiştirdim. Lakin hala aynı hatayı vermekte.
İlginiz için çok teşekkür ederim ama aynı hata hala devam etmekte.
Yardımcı olursanız çok teşekkür ederim.
 

Ekli dosyalar

Klasör yolunu aşağıdaki gibi değiştirerek deneyin.

Kod: 
yol = "e:\MEVZUAT\"
 
Sayın Levent Menteşoğlu ilginize çok teşekkür ederim. Sorun çözüldü ama şimdide xls uzantılı dosyaları açmıyordu açmasını sağladım ama yine de ShowModal = False dediğim halde yeni açtığım xls sayfası userformun altında kalmakta. Ne yaptıysam userformun üzerine getiremedim.
http://www.excel.web.tr/f48/formun-taskbarda-yer-almas-t21611.html
yukardaki linkte Korhan AYHAN(COST_CONTROL) hocamın örneğini kendi programıma uygulamaya çalıştım lakin sonuç alamadım. Image ile ilgili küçük bir hata vermekte lakin sorunu gideremedim.

Bu konda bana yardımcı olursanız sevnirim...
 

Ekli dosyalar

Selamlar,

Hata veren satırı aşağıdaki şekilde değiştirip denermisiniz.

Kod: 
hIcon = Sheets("Sayfa1").Image1.Picture.Handle
 
Bu sorunumda bana desteklerinden dolayı Sn.Levent Menteşoğlu, Sn.hamitcan, Sn. Korhan Ayhan 'a çok teşekkür ederim.

E sürücüsü içersinde MEVZAT klasörünün altında 8 klasör içersindeki dosyaların ne olduğunu görebildiğimiz ve aynı zamanda açabildiğimiz güzel bir program oldu.

Örnek dosya ekte...

Herkese iyi çalışmalar...
 

Ekli dosyalar

For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yol & altklasor.Name).Files

satırı bende sorun veriyor.
 
Class Module de;

Kod: 
Public WithEvents opt As MSForms.OptionButton
Private Sub opt_Click()
Select Case Replace(opt.Name, "OptionButton", "")
[COLOR="red"]Case 1: klasor = "MEVZUAT"[/COLOR]
[COLOR="Blue"]Case 2: klasor = "Kanun"
Case 3: klasor = "Kanun Hükmünde Kararname"
Case 4: klasor = "Yönetmelik"
Case 5: klasor = "Bakanlar Kurulu Kararları"
Case 6: klasor = "Tebliğ"
Case 7: klasor = "Genelge"
Case 8: klasor = "Emir"
Case 9: klasor = "Diğer"[/COLOR]
End Select
UserForm1.ListBox1.Clear
UserForm1.ListBox2.Clear
[COLOR="Red"]yol = "E:\MEVZUAT\"
If klasor = "MEVZUAT" Then[/COLOR]
For Each altklasor In CreateObject("Scripting.FileSystemObject").GetFolder(yol).SubFolders
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yol & altklasor.Name).Files
UserForm1.ListBox1.AddItem dosya.Name
UserForm1.ListBox2.AddItem altklasor.Name
Next
Next
Else
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yol & klasor).Files
UserForm1.ListBox1.AddItem dosya.Name
UserForm1.ListBox2.AddItem klasor
Next
End If
End Sub

ve

UserForm'da da;

Kod: 
Dim opt(9) As New Class1

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long

Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Sub ListBox1_Click()
ListBox2.ListIndex = ListBox1.ListIndex
End Sub

Private Sub SBilgi_Click()
If ListBox1.ListIndex = -1 Then
MsgBox "Listeden açılacak dosyayı seçiniz.", 32, "Uyarı..!"
Exit Sub
End If
CreateObject("Shell.Application").Open "[COLOR="red"]E:\MEVZUAT\[/COLOR]" & ListBox2 & "\" & ListBox1
End Sub

Private Sub UserForm_Activate()
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, Me.Caption)
    SetWindowLong hWnd, -16, GetWindowLong(hWnd, -16) Or &H10000 _
    Or &H20000 Or &H40000
    OptionButton1.Value = True
    AddIcon
    AddMinimiseButton
    AppTasklist Me
    End Sub

Private Sub AddIcon()
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sayfa1.Image1.Picture.Handle
    hWnd = FindWindow(vbNullString, Me.Caption)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    lngRet = DrawMenuBar(hWnd)
End Sub

Private Sub AddMinimiseButton()
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLong(hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) Or WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
    Dim WStyle As Long
    Dim Result As Long
    Dim hWnd As Long
    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_HIDEWINDOW)
    Result = SetWindowLong(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW)
End Sub

Private Sub UserForm_Initialize()
    Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
    Dim CX As Double, CY As Double
    Dim MyCtrl As Control
    X1 = 0: X2 = 0: Y1 = 0: Y2 = 0: CX = 0: CY = 0
    X1 = Me.Width
    Y1 = Me.Height
    X2 = Me.Width
    Y2 = Me.Height
    CX = X1 / X2
    CY = Y1 / Y2
    Me.Width = X1 - 3
    Me.Height = Y1 - 3
    For Each MyCtrl In Me.Controls
    MyCtrl.Top = MyCtrl.Top * CY
    MyCtrl.Left = MyCtrl.Left * CX
    MyCtrl.Width = MyCtrl.Width * CX
    MyCtrl.Height = MyCtrl.Height * CY
    On Error Resume Next
    MyCtrl.Font.Size = MyCtrl.Font.Size * CY
    On Error GoTo 0
    Next
For a = 1 To 9
Set opt(a).opt = Controls("optionbutton" & a)
Next
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Application.Quit
End Sub

kırmızı bölümleri (dosya yolunu) değiştirerek işlemlerinizi yapabilirsiniz. E sürücüsü içersine ekteki dosyayı atarsanız çalıştığını görebilirsiniz. Veya dosya yolunu(kırmızı font) ve dosya isimlerini(mavi font) değiştirerek çalıştırabilirsiniz.
Kolay gelsin..
 

Ekli dosyalar

tertok' Alıntı:
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(yol & altklasor.Name).Files

satırı bende sorun veriyor.
Genişletmek için tıkla ...

Aynı sorun bende de var ve sizin demiş olduğunuz kırmızı yazıları değiştirmeme rağmen aynı hatayı veriyor ve ben sadece E sürücüsü değilde C sürücüsü üzerinden yapmak istidem ama birtürlü olmuyor ve c'nin altına vermiş oluduğunuz klasörü ve alt klasörleriyle birlikte kopyalamama rağmen sorunu çözemedim acaba nerede yanlışlık yapıyorum. Yardım ederseniz sevinirim.
İyi çalışmalar,
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst