Textbox içeriğini kopyalamak

E

excelman

Katılım
3 Eylül 2004
Mesajlar
174
Excel Vers. ve Dili
Excel-2002 Türkçe
Merhabalar;

Userform um üzerinde OptionButton1 e tıkladığım zaman Textbox1 deki değeri kopyalamak istiyorum.

Kolay Gelsin.
 
L

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Değeri nereye kopyalayacaksınız.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Eğer bilgisayarın geçici hafızasına (clipboard) kopyalamak istiyorsanız;

[vb:1:f0015f8b60]Dim MyData As DataObject
'
Private Sub OptionButton1_Click()
If TextBox1 <> Empty Then
TextBox1.SelStart = 0
TextBox1.SelLength = TextBox1.TextLength
TextBox1.Copy
MyData.GetFromClipboard
MsgBox "TextBox1 icerigi hafizaya kopyalandı...."
Range("C1") = MyData.GetText(1)
MsgBox "Hafızadaki deger, C1 hucresine yazildi..."
End If
End Sub
'
Private Sub UserForm_Initialize()
Set MyData = New DataObject
End Sub
[/vb:1:f0015f8b60]
 
Furkan TARAKÇI

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
Merhabalar,

Private Sub TeslimBox1_Change()

y2 = KmBilgiBox1.Value + "_YY_" + KmBox1.Value + "-" + KmBox2.Value + "_" + Format(TarihBox1.Value, "yymmdd")

T1 = Application.WorksheetFunction.VLookup(CinsBox1.Value, Sheets("INFO").Range("CİNS[[Cins İsmi]:[Cins Kodu]]"), 2, False) & "-"
T2 = Application.WorksheetFunction.VLookup(BolgeBox1.Value, Sheets("INFO").Range("BÖLGE[[Bölge İsmi]:[Bölge Kodu]]"), 2, False)
T3 = Left(T2, 1)
T4 = Format(TarihBox1.Value, "yy")
On Error Resume Next
T5 = Application.WorksheetFunction.VLookup(TeslimBox1.Value, Sheets("GİRDİ").Range("PERSONEL[[Personel İsmi]:[Personel Kodu]]"), 2, False)
T6 = Left(T5, 1)
T7 = Format(TarihBox1.Value, "mm")
T8 = Right(T2, 1)
T9 = Format(TarihBox1.Value, "dd")
T10 = Right(T5, 1)
T11 = WorksheetFunction.CountIf(Sheets("KAYIT").Range("F:F"), CinsBox1.Value) + 1
T12 = Format(T11, "00#")

KodBox1.Value = T1 + T3 + T4 + T6 + T7 + T8 + T9 + T10 + T12
NameBox1.Value = y2 + "_" & KodBox1.Value

End Sub


Private Sub KaydetButton1_Click()

k1 = Split(KmBox1.Text, "+")(0) * 1000 + Split(KmBox1.Text, "+")(1)
k2 = Split(KmBox2.Text, "+")(0) * 1000 + Split(KmBox2.Text, "+")(1)

Dim Ara2 As Range
Set Ara2 = Sheets("KAYIT").Cells.Find("Kod")

Dim b, say, say1, kaydet As Byte
w = WorksheetFunction.CountIf(Sheets("KAYIT").Range("B:B"), "<>") + Ara2.Row - 1 'Kaç Tane kayıt olduğunu sayıyor.
b = Ara2.Row + 1
say = WorksheetFunction.CountIfs(Sheets("KAYIT").Range("C:C"), CDate(Format(TarihBox1.Value, "dd.mm.yyyy")), Sheets("KAYIT").Range("D:D"), k1, Sheets("KAYIT").Range("E:E"), k2, Sheets("KAYIT").Range("F:F"), CinsBox1.Value, Sheets("KAYIT").Range("G:G"), BolgeBox1.Value, Sheets("KAYIT").Range("H:H"), DetayBox1.Value, Sheets("KAYIT").Range("I:I"), DetayBox2.Value)
say1 = WorksheetFunction.CountIfs(Sheets("KAYIT").Range("D:D"), k1, Sheets("KAYIT").Range("E:E"), k2, Sheets("KAYIT").Range("F:F"), CinsBox1.Value, Sheets("KAYIT").Range("G:G"), BolgeBox1.Value, Sheets("KAYIT").Range("H:H"), DetayBox1.Value, Sheets("KAYIT").Range("I:I"), DetayBox2.Value)


For i = b To w Step 1 'Kayıt Benzerliklerini tarıyor.

If say > 0 Then
Z = 2
If Cells(i, 3) = CDate(Format(TarihBox1.Value, "dd.mm.yyyy")) Then Exit For
Else
If say = 0 And say1 > 0 Then
Z = 3
If Cells(i, 3) < CDate(Format(TarihBox1.Value, "dd.mm.yyyy")) And Cells(i, 4) = k1 And Cells(i, 5) = k2 And Cells(i, 6) = CinsBox1.Value And Cells(i, 7) = BolgeBox1.Value And Cells(i, 8) = DetayBox1.Value And Cells(i, 9) = DetayBox2.Value Then Exit For
Else
If say = 0 And say1 = 0 Then
Z = 0
End If
End If
End If

Next i


If Z > 0 Then
If Z = 3 Then
Mesaj = "Bu Bilgilere Benzer " & say1 & " Adet Kayıt Bulunmaktadır." & Chr(13) & "" & Chr(13) & "İlk Kayıt " & Sheets("KAYIT").Cells(i, 3) & " Tarihli" & Chr(13) & Sheets("KAYIT").Cells(i, 2) & " Kod Numaralı Kayıttır." & Chr(13) & "" & Chr(13) & "Yinede Kaydetmek İçin TAMAM a Yoksa İPTAL e Basın."
Baslik = "BİLGİ"
Komut = msgbox(Mesaj, vbOKCancel + vbDefaultButton2 + vbInformation, Baslik)

If Komut = 1 Then
kaydet = 1
End If
End If

If Z = 2 Then
msgbox "Bu Kayıt " & Chr(13) & Cells(i, 2) & " Kod Numarasıyla" & Chr(13) & "Oluşturulmuştur.", vbCritical, "UYARI"
End If

Else
kaydet = 1
End If

If kaydet = 1 Then

q = w + 1
ActiveWorkbook.Sheets("KAYIT").Cells(q, 1) = q - Ara2.Row
ActiveWorkbook.Sheets("KAYIT").Cells(q, 2) = KodBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 3) = CDate(Format(TarihBox1.Value, "dd.mm.yyyy"))
ActiveWorkbook.Sheets("KAYIT").Cells(q, 4) = k1
ActiveWorkbook.Sheets("KAYIT").Cells(q, 4).NumberFormat = "##0+000"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 5) = k2
ActiveWorkbook.Sheets("KAYIT").Cells(q, 5).NumberFormat = "##0+000"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 6) = CinsBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 7) = BolgeBox1.Value
If BolgeBox1.Value = "YANYOL" And ComboBox1.Value = "ANAYOLDA" Then
ActiveWorkbook.Sheets("KAYIT").Cells(q, 8) = "ANA GÖVDEDE"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 9) = DetayBox1.Value
Else
ActiveWorkbook.Sheets("KAYIT").Cells(q, 8) = DetayBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 9) = DetayBox2.Value
End If
ActiveWorkbook.Sheets("KAYIT").Cells(q, 10) = KmBilgiBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 11) = NameBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 13) = TeslimBox1.Value
If TarihBox2.Value <> "" Then
ActiveWorkbook.Sheets("KAYIT").Cells(q, 14) = CDate(Format(TarihBox2.Value, "dd.mm.yyyy"))
End If
ActiveWorkbook.Sheets("KAYIT").Cells(q, 17) = NotBox1.Value

msgbox "Kayıt Oluşturulmuştur." & Chr(13) & "" & Chr(13) & KodBox1.Value & " Kod Numarasıyla" & Chr(13) & NameBox1.Value & Chr(13) & "İsmi Oluşturulmuştur." & Chr(13) & "" & Chr(13) & "İsmi Kopyalamak İçin TAMAM a Yoksa İPTAL e Basın.", vbOKCancel + vbDefaultButton1 + vbInformation, "BİLGİ"

If Komut = 1 Then

If NameBox1 <> Empty Then
NameBox1.SelStart = 0
NameBox1.SelLength = NameBox1.TextLength
NameBox1.Copy
End If

End If

End If

End Sub

yazdığımda normalde namebox1 in içeriğini kopyalıyordu, yukardaki kodlarda değişiklikler yapınca artık userform da en son ne kopyalamışsam o geliyor. Neyi değiştirince oldu onu da bir türlü bulamadım. Yardımcı olabilirseniz sevinirim.
 
Furkan TARAKÇI

Furkan TARAKÇI

Altın Üye
Katılım
15 Şubat 2022
Mesajlar
51
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO (Sürüm 2205 Derleme 16.0.15225.20172) 64 bit Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2027
Furkan TARAKÇI' Alıntı:
Merhabalar,

Private Sub TeslimBox1_Change()

y2 = KmBilgiBox1.Value + "_YY_" + KmBox1.Value + "-" + KmBox2.Value + "_" + Format(TarihBox1.Value, "yymmdd")

T1 = Application.WorksheetFunction.VLookup(CinsBox1.Value, Sheets("INFO").Range("CİNS[[Cins İsmi]:[Cins Kodu]]"), 2, False) & "-"
T2 = Application.WorksheetFunction.VLookup(BolgeBox1.Value, Sheets("INFO").Range("BÖLGE[[Bölge İsmi]:[Bölge Kodu]]"), 2, False)
T3 = Left(T2, 1)
T4 = Format(TarihBox1.Value, "yy")
On Error Resume Next
T5 = Application.WorksheetFunction.VLookup(TeslimBox1.Value, Sheets("GİRDİ").Range("PERSONEL[[Personel İsmi]:[Personel Kodu]]"), 2, False)
T6 = Left(T5, 1)
T7 = Format(TarihBox1.Value, "mm")
T8 = Right(T2, 1)
T9 = Format(TarihBox1.Value, "dd")
T10 = Right(T5, 1)
T11 = WorksheetFunction.CountIf(Sheets("KAYIT").Range("F:F"), CinsBox1.Value) + 1
T12 = Format(T11, "00#")

KodBox1.Value = T1 + T3 + T4 + T6 + T7 + T8 + T9 + T10 + T12
NameBox1.Value = y2 + "_" & KodBox1.Value

End Sub


Private Sub KaydetButton1_Click()

k1 = Split(KmBox1.Text, "+")(0) * 1000 + Split(KmBox1.Text, "+")(1)
k2 = Split(KmBox2.Text, "+")(0) * 1000 + Split(KmBox2.Text, "+")(1)

Dim Ara2 As Range
Set Ara2 = Sheets("KAYIT").Cells.Find("Kod")

Dim b, say, say1, kaydet As Byte
w = WorksheetFunction.CountIf(Sheets("KAYIT").Range("B:B"), "<>") + Ara2.Row - 1 'Kaç Tane kayıt olduğunu sayıyor.
b = Ara2.Row + 1
say = WorksheetFunction.CountIfs(Sheets("KAYIT").Range("C:C"), CDate(Format(TarihBox1.Value, "dd.mm.yyyy")), Sheets("KAYIT").Range("D:D"), k1, Sheets("KAYIT").Range("E:E"), k2, Sheets("KAYIT").Range("F:F"), CinsBox1.Value, Sheets("KAYIT").Range("G:G"), BolgeBox1.Value, Sheets("KAYIT").Range("H:H"), DetayBox1.Value, Sheets("KAYIT").Range("I:I"), DetayBox2.Value)
say1 = WorksheetFunction.CountIfs(Sheets("KAYIT").Range("D:D"), k1, Sheets("KAYIT").Range("E:E"), k2, Sheets("KAYIT").Range("F:F"), CinsBox1.Value, Sheets("KAYIT").Range("G:G"), BolgeBox1.Value, Sheets("KAYIT").Range("H:H"), DetayBox1.Value, Sheets("KAYIT").Range("I:I"), DetayBox2.Value)


For i = b To w Step 1 'Kayıt Benzerliklerini tarıyor.

If say > 0 Then
Z = 2
If Cells(i, 3) = CDate(Format(TarihBox1.Value, "dd.mm.yyyy")) Then Exit For
Else
If say = 0 And say1 > 0 Then
Z = 3
If Cells(i, 3) < CDate(Format(TarihBox1.Value, "dd.mm.yyyy")) And Cells(i, 4) = k1 And Cells(i, 5) = k2 And Cells(i, 6) = CinsBox1.Value And Cells(i, 7) = BolgeBox1.Value And Cells(i, 8) = DetayBox1.Value And Cells(i, 9) = DetayBox2.Value Then Exit For
Else
If say = 0 And say1 = 0 Then
Z = 0
End If
End If
End If

Next i


If Z > 0 Then
If Z = 3 Then
Mesaj = "Bu Bilgilere Benzer " & say1 & " Adet Kayıt Bulunmaktadır." & Chr(13) & "" & Chr(13) & "İlk Kayıt " & Sheets("KAYIT").Cells(i, 3) & " Tarihli" & Chr(13) & Sheets("KAYIT").Cells(i, 2) & " Kod Numaralı Kayıttır." & Chr(13) & "" & Chr(13) & "Yinede Kaydetmek İçin TAMAM a Yoksa İPTAL e Basın."
Baslik = "BİLGİ"
Komut = msgbox(Mesaj, vbOKCancel + vbDefaultButton2 + vbInformation, Baslik)

If Komut = 1 Then
kaydet = 1
End If
End If

If Z = 2 Then
msgbox "Bu Kayıt " & Chr(13) & Cells(i, 2) & " Kod Numarasıyla" & Chr(13) & "Oluşturulmuştur.", vbCritical, "UYARI"
End If

Else
kaydet = 1
End If

If kaydet = 1 Then

q = w + 1
ActiveWorkbook.Sheets("KAYIT").Cells(q, 1) = q - Ara2.Row
ActiveWorkbook.Sheets("KAYIT").Cells(q, 2) = KodBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 3) = CDate(Format(TarihBox1.Value, "dd.mm.yyyy"))
ActiveWorkbook.Sheets("KAYIT").Cells(q, 4) = k1
ActiveWorkbook.Sheets("KAYIT").Cells(q, 4).NumberFormat = "##0+000"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 5) = k2
ActiveWorkbook.Sheets("KAYIT").Cells(q, 5).NumberFormat = "##0+000"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 6) = CinsBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 7) = BolgeBox1.Value
If BolgeBox1.Value = "YANYOL" And ComboBox1.Value = "ANAYOLDA" Then
ActiveWorkbook.Sheets("KAYIT").Cells(q, 8) = "ANA GÖVDEDE"
ActiveWorkbook.Sheets("KAYIT").Cells(q, 9) = DetayBox1.Value
Else
ActiveWorkbook.Sheets("KAYIT").Cells(q, 8) = DetayBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 9) = DetayBox2.Value
End If
ActiveWorkbook.Sheets("KAYIT").Cells(q, 10) = KmBilgiBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 11) = NameBox1.Value
ActiveWorkbook.Sheets("KAYIT").Cells(q, 13) = TeslimBox1.Value
If TarihBox2.Value <> "" Then
ActiveWorkbook.Sheets("KAYIT").Cells(q, 14) = CDate(Format(TarihBox2.Value, "dd.mm.yyyy"))
End If
ActiveWorkbook.Sheets("KAYIT").Cells(q, 17) = NotBox1.Value

msgbox "Kayıt Oluşturulmuştur." & Chr(13) & "" & Chr(13) & KodBox1.Value & " Kod Numarasıyla" & Chr(13) & NameBox1.Value & Chr(13) & "İsmi Oluşturulmuştur." & Chr(13) & "" & Chr(13) & "İsmi Kopyalamak İçin TAMAM a Yoksa İPTAL e Basın.", vbOKCancel + vbDefaultButton1 + vbInformation, "BİLGİ"

If Komut = 1 Then

If NameBox1 <> Empty Then
NameBox1.SelStart = 0
NameBox1.SelLength = NameBox1.TextLength
NameBox1.Copy
End If

End If

End If

End Sub

yazdığımda normalde namebox1 in içeriğini kopyalıyordu, yukardaki kodlarda değişiklikler yapınca artık userform da en son ne kopyalamışsam o geliyor. Neyi değiştirince oldu onu da bir türlü bulamadım. Yardımcı olabilirseniz sevinirim.
Genişletmek için tıkla ...
Sorunu buldum. Mesajı kaldıramadım. İnşallah zamanlarınızı çalmamışımdır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst