ComboBox

[mca609]

Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..

 

[Ergün Güler]

Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..

Selam,
dosyanızı 2003 (*.xls) formatında yollabilirseniz. Daha iyi yardım alabilirsiniz.
İyi çalışmalar.

 

[İhsan Tank]

Merhabalar. Birkaç gündür internette taramadığım yer kalmadı ama bir türlü istediğim şeyi bulamadım. Yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim. yapmak istediğim şey, bir excel kitabında sayfa2'deki bir tabloyu ( ya da bir hücre grubunu demek daha mı doğru olur) açılır menü yardımıyla sayfa1'e almak istiyorum. Açılır menüden seçim yaparak belli hücre aralığını sayfa bire alabilrmiyim..

merhaba
eki inceleyiniz

 

[mca609]

İhsan bey allah razı olsun bir haftadır nasıl olcak diye kıvrandım durdum. Bunun nasıl yapıldığından biraz bahsedebilirmisiniz..bir de aynı şekilde bir MS project Dosyasını excel de açabilir miyiz? yardımlarınız için çok teşekkür ederim.

 

[Necdet]

Merhaba,

Yanıt : 2

Aşağıdaki kod ThisWorkbook'un kod sayfasında olmalı. Dosya açıldığında combobox oluşmalı.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Sheets("Sayfa2").Select
    Sheets("Sayfa1").Select
    Application.ScreenUpdating = True
    
End Sub

Aşağıdaki kodlar ise Sayfa1'in Kod Sayfasında olmalı.

Private Sub ComboBox1_Change()
    Dim c   As Range, _
        s2  As Worksheet
    
    Set s2 = Sheets("Sayfa2")
    Set c = s2.Range("A:A").Find(ComboBox1.Value, LookIn:=xlValues)
    If c Is Nothing Then Exit Sub
    Range("A10").CurrentRegion.Delete
    s2.Range(c.Address).CurrentRegion.Copy [A10]
End Sub

Private Sub Worksheet_Activate()
    Dim i   As Long
    Dim s2  As Worksheet
    
    Set s2 = Sheets("Sayfa2")
    ComboBox1.Clear
    
    For i = 2 To s2.Cells(Rows.Count, "A").End(3).Row
        If Not s2.Cells(i, "A") = "" Then ComboBox1.AddItem s2.Cells(i, "A")
    Next i
End Sub

Sayfa2 deki bilgilerin yapısı da şöyle olmalı :

Herbir grubun arasında mutlaka en az 1 satır boş olmalı.

A sütunundaki başlığı birleştirebilirsiniz ama gruplar arasında verdiğiniz boş satırı kapsamamalı.

Durum böyle olunca istediğiniz kadar grup oluşturabilirsiniz.

 

[mca609]

Ya arkadaşlar çok afedersiniz, ben bu program işlerindn pek anlamadığımdan işin içinden çıkamadım daha önce göndermiş olduğum excel dosyasında, proje planı ve ürün özellikleri A sütununda idi şimdi isa başlık kısmını yataya aldım ve hücreleri birleştirdim,ancak combox da nasıl yapabileceğimi bulamadım, Yarına kadar bu işi çözmem lazım yardımcı olursanız çok mutlu olurum, ek de excel dosyasını ekledim.. şimdiden çok teşekkür ederim

 

[Necdet]

Kafanıza göre format değiştirirseniz kodların çalışmaması doğal.

 

[mca609]

yani hocam yok mu şimdi yardı edebilecek birisi.

 

[Necdet]

Yardım etmeyiz mi dedik?

Ama bir önceki mesajımda verdiğim otomatik durum şimdi kalktı.

Sayfa1 de N sütununu aracı sütun olarak kullandım. Üşendim uzun uzun kod yazmaya, ilk mesajımda olduğu gibi, işi kısa tuttum.

Aşağıdaki kodlar Sayfa1 in kod bölümünde olmalı.

Private Sub ComboBox1_Change()
    Dim c   As Range, _
        i   As Long, _
        s2  As Worksheet
    On Error Resume Next
    Set s2 = Sheets("Sayfa2")
    Set c = s2.Cells.Find(ComboBox1.Value, LookIn:=xlValues)
    If c Is Nothing Then Exit Sub
    i = Cells(Rows.Count, "B").End(3).Row
    If i < 10 Then
        i = 10
    Else
        i = i + 10
    End If
    Application.EnableEvents = False
    If Not Range("B10") = "" Then Rows("10:" & i).Delete Shift:=xlUp
    s2.Range(c.Address).CurrentRegion.Copy [b10]
    Application.EnableEvents = True
End Sub

 

[mca609]

hocam süpersiniz ellerine emeklerinize sağlık.. çok çok teşekkür ederim,

 

[Necdet]

hocam süpersiniz ellerine emeklerinize sağlık.. çok çok teşekkür ederim,

Süper değilim ama sizde dere geçerken at değiştirmeyin

 

[İhsan Tank]

necdet hocam'a alternatif olmaz ama

Private Sub ComboBox1_Change()
If ComboBox1 = "Proje Planı" Then
Range("A10:E20").ClearContents
Range("A10") = Sheets("Sayfa2").Range("E7").Text
Range("A11") = Sheets("Sayfa2").Range("E8").Text
Range("B11") = Sheets("Sayfa2").Range("F8").Text
Range("C11") = Sheets("Sayfa2").Range("G8").Text
Range("D11") = Sheets("Sayfa2").Range("H8").Text
Range("E11") = Sheets("Sayfa2").Range("I8").Text
Range("E12") = Sheets("Sayfa2").Range("I9").Text
Range("A12") = Sheets("Sayfa2").Range("E9").Text
Range("B12") = Sheets("Sayfa2").Range("F9").Text
Range("C12") = Sheets("Sayfa2").Range("G9").Text
Range("D12") = Sheets("Sayfa2").Range("H9").Text
Range("E12") = Sheets("Sayfa2").Range("I9").Text
Range("A13") = Sheets("Sayfa2").Range("E10").Text
Range("B13") = Sheets("Sayfa2").Range("F10").Text
Range("C13") = Sheets("Sayfa2").Range("G10").Text
Range("D13") = Sheets("Sayfa2").Range("H10").Text
Range("E13") = Sheets("Sayfa2").Range("I10").Text
Range("A14") = Sheets("Sayfa2").Range("E11").Text
Range("B14") = Sheets("Sayfa2").Range("F11").Text
Range("C14") = Sheets("Sayfa2").Range("G11").Text
Range("D14") = Sheets("Sayfa2").Range("H11").Text
Range("E14") = Sheets("Sayfa2").Range("I11").Text
Range("A15") = Sheets("Sayfa2").Range("E12").Text
Range("B15") = Sheets("Sayfa2").Range("F12").Text
Range("C15") = Sheets("Sayfa2").Range("G12").Text
Range("D15") = Sheets("Sayfa2").Range("H12").Text
Range("E15") = Sheets("Sayfa2").Range("I12").Text
ElseIf ComboBox1 = "Ürün Özellikleri" Then
Range("A10:E20").ClearContents
Range("A10") = Sheets("Sayfa2").Range("E14").Text
Range("B11") = Sheets("Sayfa2").Range("F15").Text
Range("C11") = Sheets("Sayfa2").Range("G15").Text
Range("D11") = Sheets("Sayfa2").Range("H15").Text
Range("B12") = Sheets("Sayfa2").Range("F16").Text
Range("C12") = Sheets("Sayfa2").Range("G16").Text
Range("D12") = Sheets("Sayfa2").Range("H16").Text
Range("B13") = Sheets("Sayfa2").Range("F17").Text
Range("C13") = Sheets("Sayfa2").Range("G17").Text
Range("D13") = Sheets("Sayfa2").Range("H17").Text
Range("B14") = Sheets("Sayfa2").Range("F18").Text
Range("C14") = Sheets("Sayfa2").Range("G18").Text
Range("D14") = Sheets("Sayfa2").Range("H18").Text
Range("B15") = Sheets("Sayfa2").Range("F19").Text
Range("C15") = Sheets("Sayfa2").Range("G19").Text
Range("D15") = Sheets("Sayfa2").Range("H19").Text
Range("B16") = Sheets("Sayfa2").Range("F20").Text
Range("C16") = Sheets("Sayfa2").Range("G20").Text
Range("D16") = Sheets("Sayfa2").Range("H20").Text
End If
End Sub

bu kod işinizi görebilir

 

[mca609]

Peki bir Soru daha ComboBoxla Ms project nasıl açarım, yani istiyorum combobox açıldığında plan, ve ürün özelliklerine tıkladığımda sayfa 2 den tablolardan veri alsın(tamam bunu çözdük diyebilir
z) ama asıl yapmak isteediğiim, Ms project tıkladığımda bir MS project dosyası açsın. şimdiden teşekkürler