• DİKKAT

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

firma bilgilerini listesini ayrı bir sayfada ilgili yerlere çağırmak

  • Konbuyu başlatan Konbuyu başlatan enmer
  • Başlangıç tarihi Başlangıç tarihi
E

enmer

Katılım
4 Ekim 2008
Mesajlar
30
Excel Vers. ve Dili
Excel 2007 Türkçe
Ekdeki iki dosyada (müşteri, teklif formu) birinde firma bilgileri digerinde bu bilgilerin doldurulacagı kapak sayfası(teklif formu) mevcut. sizlerden ricam teklif formundaki kırmızı logoya tıklandıgında bir liste açılsın (müşteriler listesi) çıkan sayfada firma ismine göre arama yapıp firmayı sectigimizde ilgili yerelere (firma adı, adres, telefon, fax, e-mail, sayın:) doldursun yanlış bir secim yaptıgımızda veya ilgili yerler dolu olsa bile eski bilgiyi silip tekrar yazsın. müşteri dosyayı kapalı olsa bile arama yapması gerekiyor. ekde ürünler dosyasındaki userforum a tıklandıgında çıkan sayfanın aynı olursa çok sevinirim bu userforumuda yine forumumuzdan bir arkadaş yapmıştı kendisine tekrar ulaşamadım. kendisine burdan tekrar teşekür ediyorum. aslına bakılırsa ürünler dosyasındaki makro kodunun aynısı tek farkı burada arka arkaya sıralanmayacak sadece listeden sectigimde ilgili yerleri dolduracak makro bilgim olmadıgından ilgili makroyu bu şekle çeviremedim :( yani ürünler bölümündeki makroyu kullanabilirsiniz. sizlere fikir vermesi açısından fiyatlar dosyasınıda ekliyorum. zira fyatlar ve ürünler dosyaları birlikte çalışıyor.

Yardımlarınızdan dolayı şimdiden çok teşekkür ederim herkeze iyi çalışmalar dilerim..
 

Ekli dosyalar

enmer' Alıntı:
Ekdeki iki dosyada (müşteri, teklif formu) birinde firma bilgileri digerinde bu bilgilerin doldurulacagı kapak sayfası(teklif formu) mevcut. sizlerden ricam teklif formundaki kırmızı logoya tıklandıgında bir liste açılsın (müşteriler listesi) çıkan sayfada firma ismine göre arama yapıp firmayı sectigimizde ilgili yerelere (firma adı, adres, telefon, fax, e-mail, sayın:) doldursun yanlış bir secim yaptıgımızda veya ilgili yerler dolu olsa bile eski bilgiyi silip tekrar yazsın. müşteri dosyayı kapalı olsa bile arama yapması gerekiyor.
Yardımlarınızdan dolayı şimdiden çok teşekkür ederim herkeze iyi çalışmalar dilerim..
Genişletmek için tıkla ...


Sayın enmer

Ekli dosyayı inceleyiniz.
 

Ekli dosyalar

Son düzenleme:
Sayın Kuman Allah razı olsun
Harika olmuş.. ellerinize sağlık...
 
kuman bey sizden bir ricam olacak yapmış oldugunuz dosyayı kullanmaya başladım yanlız çok fazla şirket ismi mevcut userforum a bir arama motoru koya bilirmiyiz firma ismine göre arama yapabilir şimdiden çok teşekkür ediyorum
 
slm

kuman bey göndermiş oldugunuz dosyadaki userforma bul ve liste bölümü ekledim çalışma mantıgı şöyle olması gerekiyor. firma ismini veya bir bölümünü bul a yazdıgımda aşagıda ona yakın olan lar listelenecek sonra mausla tek klik yaptıgımda yandaki listede ayrıntılarını görecegim çift klik yaptıgımda veya aktar butonuna bastıgımda ise kapak sayfasına aktaracak. istedigim şeyin kolay olmadıgının farkındayım ama yapılabilirse inanın çok çok işime yarayacak ve tek telimeyle mükemmel olacak yardımcı olabilecek diger arkadaşlar için 2003 formatında yüklüyorum.
 

Ekli dosyalar

enmer' Alıntı:
kuman bey göndermiş oldugunuz dosyadaki userforma bul ve liste bölümü ekledim çalışma mantıgı şöyle olması gerekiyor. firma ismini veya bir bölümünü bul a yazdıgımda aşagıda ona yakın olan lar listelenecek sonra mausla tek klik yaptıgımda yandaki listede ayrıntılarını görecegim çift klik yaptıgımda veya aktar butonuna bastıgımda ise kapak sayfasına aktaracak. istedigim şeyin kolay olmadıgının farkındayım ama yapılabilirse inanın çok çok işime yarayacak ve tek telimeyle mükemmel olacak yardımcı olabilecek diger arkadaşlar için 2003 formatında yüklüyorum.
Genişletmek için tıkla ...

Sayın enmer

Dosyanızda değişiklik yapıldı.

Ekli dosyayı iceleyiniz.
 

Ekli dosyalar

Sayın Kuman,

örneğiniz çok güzel olmuş,elinize sağlık Bu dosyayı atölye formu çalışmama eklemek istersem
örnekteki userform1 object'ine daha fazla satır ekliyebilirmiyiz.Mesela vergi dairesi,vergi numarası,cep telefonu,Şantiye telefonu ve şantiye faksı gibi.

Saygılarımla,
İhsan YILMAZ
 
Elbette eklenebilir, Eklediğiniz sütunlar ile ilgili olarak Vba kodlarında ilaveler yapmalısınız.
 
Merhaba Kuman bey
Değişiklik harika olmuş ellerinize saglık tam istediğim gibi teşekkür ederi
iyi çalışmalar dilerim...
 
MErhabalar Kuman bey;

Verdiğiniz dosyadan oldukça yararlandım. Ancak ufak bir problemim var.


Ne zaman

ListBox1.List(s, 0) = ActiveWorkbook.Sheets("DATA").Cells(sat, "a")
ListBox1.List(s, 1) = ActiveWorkbook.Sheets("DATA").Cells(sat, "b")
ListBox1.List(s, 2) = ActiveWorkbook.Sheets("DATA").Cells(sat, "c")
ListBox1.List(s, 3) = ActiveWorkbook.Sheets("DATA").Cells(sat, "d")
ListBox1.List(s, 4) = ActiveWorkbook.Sheets("DATA").Cells(sat, "e")
ListBox1.List(s, 5) = ActiveWorkbook.Sheets("DATA").Cells(sat, "f")
ListBox1.List(s, 6) = ActiveWorkbook.Sheets("DATA").Cells(sat, "g")
ListBox1.List(s, 7) = ActiveWorkbook.Sheets("DATA").Cells(sat, "h")
ListBox1.List(s, 8) = ActiveWorkbook.Sheets("DATA").Cells(sat, "i")
ListBox1.List(s, 9) = ActiveWorkbook.Sheets("DATA").Cells(sat, "j")
ListBox1.List(s, 10) = ActiveWorkbook.Sheets("DATA").Cells(sat, "k")
Genişletmek için tıkla ...

yani 10. yu eklediğim zaman "run time error 380" hatası alıyorum ve liste yuklenmiyor dolayısıyla programı çalıştıramıyorum.

Gerekli yerlerdeki eklemeleri yapıyorum. Ekte değişklik yaptığım ve 10. satırı ekleyerek çalıştıramadığım dosyayı gonderiyorum.
 

Ekli dosyalar

Sayın pokemal

Listbox'a eklemiş olduğunuz 11. sutundan dolayı hata uyarısı alıyorsunuz.
Arkadaşımızın talepleri doğrultusunda hazırlanmış olan mevcut dosyada Listbox'daki şartlı veri alımına bağlı olarak ancak 10 sütun görüntülenebilmektedir.
 
dizi yöntemi ile 10 sütundan fazla veri alabilirsiniz.
Üstelik add item yönteminele kıyaslanmayacak hızda çalışır.Çok hızlıdır.
Ben deneme fırsatım olmadı .Kodları yazdım ama ilgili sayfa dosyanızda yoktıu.
Dosyanız ektedir.:cool:
Kod: 
Private Sub TextBox1_Change()
Dim sat, s As Integer, myarr(), a(), sat2 As Long
Dim deg1, deg2 As String, sut As Byte, n As Long
ListBox1.Clearr
sat2 = ActiveWorkbook.Sheets("DATA").Cells(65536, "A").End(xlUp).Row
If sat2 < 2 Then Exit Sub
deg2 = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ"))
a = ActiveWorkbook.Sheets("DATA").Range("A2:K" & _
sat2).Value
ReDim myarr(1 To 11, 1 To UBound(a, 1))
For sat = 1 To UBound(a, 1)
    deg1 = UCase(Replace(Replace(a(sat, 1), "ı", "I"), "i", "İ"))
    If deg1 Like "*" & deg2 & "*" Then
        n = n + 1
        For sut = 1 To 11
            myarr(sut, n) = a(sat, sut)
        Next sut
    End If
Next sat
If n > 0 Then
    ReDim Preserve myarr(1 To 11, 1 To n)
    ListBox1.Column = myarr
End If
Erase a: Erase myarr
End Sub
 

Ekli dosyalar

Kuman' Alıntı:
Sayın pokemal

Listbox'a eklemiş olduğunuz 11. sutundan dolayı hata uyarısı alıyorsunuz.
Arkadaşımızın talepleri doğrultusunda hazırlanmış olan mevcut dosyada Listbox'daki şartlı veri alımına bağlı olarak ancak 10 sütun görüntülenebilmektedir.
Genişletmek için tıkla ...

Anladım Kuman Bey.

Benim 15 tane farklı alanım var o yuzden 10 tane yetmedi.


Evren Gizlen' Alıntı:
dizi yöntemi ile 10 sütundan fazla veri alabilirsiniz.
Üstelik add item yönteminele kıyaslanmayacak hızda çalışır.Çok hızlıdır.
Ben deneme fırsatım olmadı .Kodları yazdım ama ilgili sayfa dosyanızda yoktıu.
Dosyanız ektedir.:cool:
Kod: 
Private Sub TextBox1_Change()
Dim sat, s As Integer, myarr(), a(), sat2 As Long
Dim deg1, deg2 As String, sut As Byte, n As Long
ListBox1.Clearr
sat2 = ActiveWorkbook.Sheets("DATA").Cells(65536, "A").End(xlUp).Row
If sat2 < 2 Then Exit Sub
deg2 = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ"))
a = ActiveWorkbook.Sheets("DATA").Range("A2:K" & _
sat2).Value
ReDim myarr(1 To 11, 1 To UBound(a, 1))
For sat = 1 To UBound(a, 1)
    deg1 = UCase(Replace(Replace(a(sat, 1), "ı", "I"), "i", "İ"))
    If deg1 Like "*" & deg2 & "*" Then
        n = n + 1
        For sut = 1 To 11
            myarr(sut, n) = a(sat, sut)
        Next sut
    End If
Next sat
If n > 0 Then
    ReDim Preserve myarr(1 To 11, 1 To n)
    ListBox1.Column = myarr
End If
Erase a: Erase myarr
End Sub
Genişletmek için tıkla ...

Sayın evren gizlen;

Verdiğiniz dosyayı çalıştırmaya çalıştığımda 2-3 yerde hata verdi. Ekte dosyanın gerek duyduğu MUSTERİ.xls dosyasını da gönderiyorum. Bakabilirseniz minnettar olurum. Aynı zamanda Kuman Beyin yaptığı ve kendime göre şablonu değiştirdiğim dosyayı da rapidshare e ekledim gonderiyorum.

kuman.Open "Select * from [DATA$];", my, 1, 1
Private Sub TextBox1_Change()

http://rapidshare.com/files/409521458/teklif_formu.xls
 

Ekli dosyalar

Dedim ya kodları deneyemedim.
Nasıl çalıştığını bişlmiyordum.Sizde açıklamamışsınız.Kararlama yapmıştım.Ama yindeede 1 yet-rde hata yapmışım onun yerinde kalan yerler doğru çalışıyor.
Ondada syntex hatası yapmışım.Basit bir şey görünce hemen farkediliyor.Oysa sizde onu farkedip düzeltseyediniz çalışcaktı.Hata şu imiş.
Kod: 
ListBox1.Clearr
Doğrusu
Kod: 
ListBox1.Clear
Bir r fazla tuşlara basarken yazmışım.
Dosyanız ekte sorunsuz çalışıyor.:cool:
Private Sub TextBox1_Change()
Dim sat, s As Integer, myarr(), a(), sat2 As Long
Dim deg1, deg2 As String, sut As Byte, n As Long
ListBox1.Clear
sat2 = ActiveWorkbook.Sheets("DATA").Cells(65536, "A").End(xlUp).Row
If sat2 < 2 Then Exit Sub
deg2 = UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ"))
a = ActiveWorkbook.Sheets("DATA").Range("A2:K" & _
sat2).Value
ReDim myarr(1 To 11, 1 To UBound(a, 1))
For sat = 1 To UBound(a, 1)
deg1 = UCase(Replace(Replace(a(sat, 1), "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
n = n + 1
For sut = 1 To 11
myarr(sut, n) = a(sat, sut)
Next sut
End If
Next sat
If n > 0 Then
ReDim Preserve myarr(1 To 11, 1 To n)
ListBox1.Column = myarr
End If
Erase a: Erase myarr
End Sub

Private Sub TextBox5_Change()

End Sub

Private Sub TextBox81_Change()

End Sub

Private Sub TextBox84_Change()

End Sub

Private Sub UserForm_Initialize()
With ListBox1
.Clear
.ColumnCount = 10
.ColumnWidths = "100;0;0;0;0;0;0;0;0;0"
End With
TextBox1 = ".": TextBox1 = ""
End Sub
 

Ekli dosyalar

Sayın Evren Gizlen;

Cevabınız için çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst