Seçilen hücreye göre userformun açılması

[Gold_Savt]

Bir userform hazırladım ancak bunun button ile açılmasını istemiyorum.
Seçilen hücreye göre açılmalı. açıldığında da seçilen satırın bilgileriyle birlikte açılmalı.
örnek dosya ektedir. Umarım bir çözümü vardır.

 

[BAZGİRET]

Merhaba,
Böyle bir şey olacak sanırım. Hücreleri çift tıklamanız gerekir.

 

[Gold_Savt]

BAZGİRET Userform açılıyor ancak kaydetme işi devre dışı kaldı.
Kaydetme özelliğini de kaybetmemesi lazım.

 

[Gold_Savt]

Konu günceldir arkadaşlar.

 

[hmtstc]

Hocam merhaba, gold üyelik olmadığından dosyayı göremiyorum ama benzer durumda şunu yapmıştım, worksheet_selectionChange ile sayfaya bir makro yazıp onu çağırabilirsiniz. İhtiyaca göre verileri değiştirebilirsiniz.


ör:

Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("C2", "B5") ' buraya tıklanacak hücreleri yazınız

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Call userformac ' makronun adı başka bir şey olabilir.

End If
End Sub

Sub userformac()
Application.ScreenUpdating = False
Set syf = ActiveSheet
sütun = ActiveCell.Column
satır = ActiveCell.Row

sütun1 = 5 ' bu sayılar örnektir, kendiniz seçebilirsiniz
sütun2 = 6 ' bu sayılar örnektir, kendiniz seçebilirsiniz
sütun3 = 7 ' bu sayılar örnektir, kendiniz seçebilirsiniz
'
userform1.textbox1.Value = syf.Cells(satır, sütun1)
userform1.textbox2.Value = syf.Cells(satır, sütun2)
userform1.textbox3.Value = syf.Cells(satır, sütun3)

userform1.Show


End Sub

 

[BAZGİRET]

Yeni kayıtları userform yoluyla mı yapacaksınız.

 

[Gold_Savt]

Yeni kayıtları userform yoluyla mı yapacaksınız.

Tek tıklama yapıldığında excel tablosuna manuel yolla.
Sizin eklediğiniz şekliyle çift tıklandığında da UserForm yoluyla olacak.

[/QUOTE]

Hocam merhaba, gold üyelik olmadığından dosyayı göremiyorum ama benzer durumda şunu yapmıştım, worksheet_selectionChange ile sayfaya bir makro yazıp onu çağırabilirsiniz. İhtiyaca göre verileri değiştirebilirsiniz.

Örnek Formu ekleyeyim

İndir ornekk

Dosyayı indir ornekk

dosya.co

 

[BAZGİRET]

TextBoxlara yeni veri yazılıp kaydet düğmesine basılınca veriler excel dosyasına yazılacak.
Excel satırı çift tıklannca aktif satırın verileri userform açılıp oraya yüklenecek. Doğru ise eki inceleyin.

 

[Gold_Savt]

Eklediğiniz KAYDET butonu yeni kayıt için çok güzel ve kullanışlı, hatta bunu kullanacağım.
Ancak seçtiğimiz satırı düzeltmek yerine YENİ KAYIT yapıyor. Acaba yeni bir buton koyup DÜZENLE düğmesi mi koymalıyız. O şekilde seçili satırdaki bilgileri güncelleme şansımız olabilir mi?

 

[BAZGİRET]

İnceleyiniz. Veri güncelleme ve veri silme eklendi.

 

[Gold_Savt]

Sayın BAZGİRET; beklentimin üzerinde olmuş teşekkür ediyorum.
Çok şey istiyorsun demezseniz eğer; TextBox3 'ü, ComboBox'a çevirebilir miyiz? Açılır Listeyi ad yöneticisinden çekeceğim.
Birde işlemimiz A sütunundan değilde B sütunundan başlayacak.
Bu haline bile minnettarım, ilginiz için teşekkür ederim.

 

[BAZGİRET]

Sıra numarasının bulunduğu A sütunu boş bırakılıp B sütununa mı alınacak?
Birer Sütun sağa taşınacak o halde doğru mu?

 

[Gold_Savt]

A sütununda sadece sıra numarası var, oda otomatik atıyor zaten. Userformda olmasına gerek yok.
Userformdaki ilk kutucuk B'deki "isim" hücrelerini gösterecek.

 

[BAZGİRET]

Combobox1 şu haliyle iş görmektedir. Userform açıkken diğer verileri görme şansı veriyor. Bir de silme düğmesi içine silinecek veriye ulaşmayı kolaylaştırıyor. Ama buna gerek yok derseniz kaldırmak mümkündür.

 

[BAZGİRET]

Bu şekilde olsun derseniz
Buyrun
Ayrıca mesaj #10 daki dosya güncellendi.
İki dosyayı da yükledim

 

[Gold_Savt]

Sayın BAZGİRET, 10 mesajnızdaki örneğe göre çalışmamı düzenledim.
Birtek (benzersiz id) durumunda olan combobox1'i B sütunundaki Ad Soyad'a çekemedim.
Saatlerdir formüller üzerinde deneme, yanılma uyguluyorum. Son noktayı yine siz koyarsınız muhtemelen.

 

[polis-53]

UserForm Kodlarını aşağıdakiyle değiştirin
Dim Bul As Range
Private Sub ComboBox1_DropButtonClick()
ComboBox1.RowSource = "Sayfa1!b2:b" & [Sayfa1!b65536].End(3).Row
End Sub

Private Sub ComboBox2_Change()

End Sub

Private Sub CommandButton1_Click()
satır = Range("b500").End(xlUp).Row + 1
Cells(satır, 2).Value = TextBox1.Value
Cells(satır, 3).Value = TextBox2.Value
Cells(satır, 4).Value = ComboBox2.Value
Cells(satır, 5).Value = TextBox4.Value

Cells(satır, "b").Value = WorksheetFunction.Max(Range("b2:b" & Rows.Count)) + 1
End Sub
Private Sub ComboBox1_Click()
On Error Resume Next

Dim c As Range, S1 As Worksheet
Set S1 = Sheets("Sayfa1")
Set c = S1.[b:b].Find(ComboBox1.Value, , xlValues, xlWhole)
If Not c Is Nothing Then
S1.Cells(c.Row, "b").Select
End If
TextBox1.Value = ActiveCell.Offset(0, 1)
TextBox2.Value = ActiveCell.Offset(0, 2)
ComboBox2.Value = ActiveCell.Offset(0, 3)
TextBox4.Value = ActiveCell.Offset(0, 4)
End Sub


Private Sub CommandButton2_Click()
ComboBox1.Value = ""
TextBox1.Value = ""
TextBox2.Value = ""
ComboBox2.Value = ""
TextBox4.Value = ""
End Sub


Private Sub CommandButton3_Click()
ds = ActiveCell.Row

Worksheets("Sayfa1").Cells(ds, 2) = TextBox1.Value
Worksheets("Sayfa1").Cells(ds, 3) = TextBox2.Value
Worksheets("Sayfa1").Cells(ds, 4) = ComboBox2.Value
Worksheets("Sayfa1").Cells(ds, 5) = TextBox4.Value

End Sub

Private Sub CommandButton4_Click()
On Error Resume Next
YesNo = MsgBox("Silme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı")
Select Case YesNo
Case vbYes

If ComboBox1.Value <> "" Then
Rows(ActiveCell.Row).Delete
Else
MsgBox "Öncelikle Silinecek Veriyi Bulmalısın"
End If
For i = 2 To Sheets("Sayfa1").Cells(Rows.Count, "b").End(xlUp).Row
Cells(i, "b").Value = i - 1
Next
Case vbNo
MsgBox "Silme işlemini iptal ettiniz.", vbMsgBoxSetForeground
End Select

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label5_Click()

End Sub

Private Sub UserForm_Activate()
UserForm1.ComboBox1.Value = ActiveCell.Offset(0, 1)
UserForm1.TextBox1.Value = ActiveCell.Offset(0, 2)
UserForm1.TextBox2.Value = ActiveCell.Offset(0, 3)
UserForm1.ComboBox2.Value = ActiveCell.Offset(0, 4)
UserForm1.TextBox4.Value = ActiveCell.Offset(0, 5)

End Sub

 

[polis-53]

Dim Bul As Range Private Sub ComboBox1_DropButtonClick() ComboBox1.RowSource = "Sayfa1!b2:b" & [Sayfa1!b65536].End(3).Row End Sub Private Sub ComboBox2_Change() End Sub Private Sub CommandButton1_Click() satır = Range("b500").End(xlUp).Row + 1 Cells(satır, 2).Value = TextBox1.Value Cells(satır, 3).Value = TextBox2.Value Cells(satır, 4).Value = ComboBox2.Value Cells(satır, 5).Value = TextBox4.Value Cells(satır, "b").Value = WorksheetFunction.Max(Range("b2:b" & Rows.Count)) + 1 End Sub Private Sub ComboBox1_Click() On Error Resume Next Dim c As Range, S1 As Worksheet Set S1 = Sheets("Sayfa1") Set c = S1.[b:b].Find(ComboBox1.Value, , xlValues, xlWhole) If Not c Is Nothing Then S1.Cells(c.Row, "b").Select End If TextBox1.Value = ActiveCell.Offset(0, 1) TextBox2.Value = ActiveCell.Offset(0, 2) ComboBox2.Value = ActiveCell.Offset(0, 3) TextBox4.Value = ActiveCell.Offset(0, 4) End Sub Private Sub CommandButton2_Click() ComboBox1.Value = "" TextBox1.Value = "" TextBox2.Value = "" ComboBox2.Value = "" TextBox4.Value = "" End Sub Private Sub CommandButton3_Click() ds = ActiveCell.Row Worksheets("Sayfa1").Cells(ds, 2) = TextBox1.Value Worksheets("Sayfa1").Cells(ds, 3) = TextBox2.Value Worksheets("Sayfa1").Cells(ds, 4) = ComboBox2.Value Worksheets("Sayfa1").Cells(ds, 5) = TextBox4.Value End Sub Private Sub CommandButton4_Click() On Error Resume Next YesNo = MsgBox("Silme işlemi yapılacak onaylıyor musunuz?", vbYesNo + vbCritical, "Silme Onayı") Select Case YesNo Case vbYes If ComboBox1.Value <> "" Then Rows(ActiveCell.Row).Delete Else MsgBox "Öncelikle Silinecek Veriyi Bulmalısın" End If For i = 2 To Sheets("Sayfa1").Cells(Rows.Count, "b").End(xlUp).Row Cells(i, "b").Value = i - 1 Next Case vbNo MsgBox "Silme işlemini iptal ettiniz.", vbMsgBoxSetForeground End Select End Sub Private Sub Label1_Click() End Sub Private Sub Label5_Click() End Sub Private Sub UserForm_Activate() UserForm1.ComboBox1.Value = ActiveCell.Offset(0, 1) UserForm1.TextBox1.Value = ActiveCell.Offset(0, 2) UserForm1.TextBox2.Value = ActiveCell.Offset(0, 3) UserForm1.ComboBox2.Value = ActiveCell.Offset(0, 4) UserForm1.TextBox4.Value = ActiveCell.Offset(0, 5) End Sub ​

 

[Gold_Savt]

polis_53 güncelle ve kayıt dediğimizde bir yana kaydırarak kaydediyor.
Ad soyadı değişirmiyor malesef.

 

[BAZGİRET]

Merhaba,
Son eklediğiniz dosya bir bakıma dereyi geçerken at değiştirmek gibi bir şey oldu. Başlangıç dosya formatından farklı.
Eki inceleyin.