Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()

txtLastValue.Text = Cells( _
Cells(Rows.Count, 1).End(xlUp).Row, 1).Text
End Sub

Option Explicit

Private Sub cmdEintragen_Click()

Dim iRow As Integer
Dim sTxt As String
sTxt = txtText.Text
sTxt = WorksheetFunction.Substitute(sTxt, vbLf, "")
Do
iRow = iRow + 1
If InStr(sTxt, vbCr) Then
Cells(iRow, 1).Value = Left(sTxt, InStr(sTxt, vbCr) - 1)
sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, vbCr))
Else
Cells(iRow, 1).Value = sTxt
Exit Do
End If
Loop
Unload Me
End Sub

Private Sub UserForm_Initialize()
txtText.Text = _
"A.Aşkın KÜÇÜKKAYA" & vbCr & _
"Kabataş Ordu" & vbCr & _
"52520" & vbCr & _
"http://www.kod.gen.tr" & vbCr & _
"Excel Ötesi" & vbCr & _
"askinkk@kod.gen.tr"
cmdEintragen.SetFocus
End Sub

Private Sub txtNumber_Change()

Dim sTxt As String
sTxt = txtNumber.Text
If sTxt = "" Then Exit Sub
If Right(sTxt, 1) Like "[0-9]" = False Then
txtNumber.Text = Left(sTxt, Len(sTxt) - 1)
End If
End Sub

Private Sub TextBox1_KeyPress _
(ByVal KeyAscii As MSForms.ReturnInteger)

If InStr(1, "0123456789", Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub UserForm_Initialize()

Dim iCounter As Integer
For iCounter = 1 To 5
Controls("txt" & iCounter).Text = iCounter
Next iCounter
End Sub

Private Sub txtEdit_Change()

Range("A1").Value = txtEdit.Text
End Sub

Private Sub UserForm_Initialize()

txtEdit.Text = Range("A1").Value
End Sub

Private Sub txtDate_Change()

Dim sDate As String
sDate = txtDate.Text
If sDate = "" Then Exit Sub
If Not Right(sDate, 1) Like "[0-9]" Then
sDate = Left(sDate, Len(sDate) - 1)
txtDate.Text = sDate
End If
If Len(sDate) = 6 Then
sDate = Format(DateSerial( _
"20" & Right(sDate, 2), _
Mid(sDate, 3, 2), _
Left(sDate, 2) _
), "dd.mm.yy")
txtDate.Text = sDate
End If
End Sub

Private Sub cmdFirst_Click()

With txtFirst
.SetFocus
.SelStart = 3 '3. karekterden başlar
.SelLength = 2 '2 karekter seç
End With
End Sub

Private Sub UserForm_Initialize()

txtFirst.Text = Format( _
DateSerial(Year(Date), Month(Date), 12), "dd.mm.yyyy")
End Sub

Private Sub UserForm_Initialize()

With TextBox1
.Value = "www.kod.gen.tr"
.SelStart = 0
.SelLength = .TextLength
End With

Private Sub txtDatum_Change()
'textboxsa, günü ve ayı yazın yılı otomatik tamamlasın
'tarih girişlerinde aralara nokta girmenize gerek yoktur.
Dim dat As Date
Dim iRow As Integer
Dim sTxt As String
sTxt = txtDatum.Text
If sTxt = "" Then Exit Sub
If Right(sTxt, 1) Like "[0-9]" = False Then
Beep
sTxt = Left(sTxt, Len(sTxt) - 1)
txtDatum.Text = sTxt
End If
If Len(sTxt) = 4 Then
On Error Resume Next
dat = DateSerial(Year(Date), Right(sTxt, 2), Left(sTxt, 2))
If Err > 0 Then
MsgBox "Hatalı Tarih Girişi"
Err = 0
txtDatum.Text = ""
Exit Sub
End If
iRow = WorksheetFunction.CountA(Columns(1)) + 1
Cells(iRow, 1) = dat
txtDatum.Text = ""
End If
End Sub

Private Sub cmdEintragen_Click()

Dim dValue As Double

If optWaehrung.Value = True Then
'ondalıklı sayı olarak ve sonuna para simgesini
'yazdırır (13,52 YTL)
Range("A1").NumberFormat = "#,##0.00 $"
ElseIf optKolonne.Value = True Then
'ondalıklı sayı olarak yazdırır (13,52)
Range("A1").NumberFormat = "#,##0.00"
ElseIf optSingle.Value = True Then
'Ondalıklı kısmı atarak yazar (13)
Range("A1").NumberFormat = "0"
Else
'Rakamın sonuna & işareti koyar (13,52%)
Range("A1").NumberFormat = "0.00%"
End If
dValue = CDbl(txtWert.Text)
If optProzent.Value = True Then dValue = dValue / 100
Range("A1") = dValue
End Sub

Private Sub cmdOK_Click()

'Eğer textbox'a girilen şifrelerin karekter olarak
'*** şeklinde olmasını istiyor iseniz PasswordChar değerine
' * karekterini giriniz.
If txtPasswort.Text = "kodgentr" Then
MsgBox "Tebrikler! Şifre Doğrulandı"
Unload Me
Else
MsgBox "Üzgünüm! Yazdığınız Şifre Hatalı"
txtPasswort.Text = ""
txtPasswort.SetFocus
End If

End Sub

Private Sub cmdAusTabelle_Click()
txtRunden.Value = WorksheetFunction.Round( _
Range("A1").Value, 2)
End Sub

Private Sub cmdAusTextBox_Click()

txtRunden.Value = WorksheetFunction.Round( _
CDbl(txtBasis.Value), 2)
End Sub

Private Sub txtPruefung_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If Chr(KeyAscii) Like "[0-9 a-z A-Z]" = False Or _
KeyAscii = 32 Then
Beep
MsgBox "Lütfen kelimeler arasında boşluk vermeyin"
KeyAscii = 0
End If
End Sub

Private Sub cmdMargin_Click()

With txtMargin
.SelectionMargin = Not .SelectionMargin
.SetFocus
End With


End Sub

Private Sub scbSelect_Change()

scbSelect.SetFocus
txtSelect.SelStart = scbSelect.Value
txtSelect.SelLength = 1
txtSelect.SetFocus
End Sub

Private Sub UserForm_Initialize()

With txtSelect
.SetFocus
.SelStart = 0
.SelLength = 1
End With
scbSelect.Max = Len(txtSelect.Text) - 1
End Sub

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

If Len(TextBox1.Text) < 16 Then Cancel = True
End Sub

Private Sub TextBox1_Change()

If Len(TextBox1.Text) = 16 Then
If IsDate(TextBox1.Text) = False Then
MsgBox "İstenilen Sayıda Karekter Girdiniz"
Else
‘Mesaj kutusunda soldan 10 sağdan 5 karakteri gösterir
MsgBox "Tarih: " & Left(TextBox1.Text, 10) & vbLf & "Saat: " & _
Right(TextBox1.Text, 5)
End If
End If
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If Chr(KeyAscii) Like "[0-9.: ]" = False Then
KeyAscii = 0
End If
End Sub

Private Sub UserForm_Initialize()

Dim lngRow As Long
Dim strTxt As String
lngRow = 1
Do Until IsEmpty(Cells(lngRow, 1))
strTxt = strTxt & Cells(lngRow, 1) & vbLf
lngRow = lngRow + 1
Loop
txt.Text = Left(strTxt, Len(strTxt) - 1)
End Sub

Private Sub cmdOK_Click()


Dim datStart As Date, datEnde As Date
Dim iRow As Integer
datStart = DateValue(txtStart.Text)
datEnde = DateValue(txtEnde.Text)
For iRow = 1 To datEnde - datStart + 1
Cells(iRow, 1) = datStart + iRow - 1
Next iRow
Unload Me
End Sub

Private Sub UserForm_Initialize()

Dim intCounter As Integer
For intCounter = 1 To 4
Set txtBoxes(intCounter).TxtGroup = Controls("TextBox" & intCounter)
Next intCounter
End Sub

Private Sub cmdOK_Click()

Dim rngStart As Range, rngEnd As Range
Set rngStart = Columns(1).Find( _
what:=DateValue(txtStart.Text), LookIn:=xlFormulas)
Set rngEnd = Columns(1).Find( _
what:=DateValue(txtEnd.Text), LookIn:=xlFormulas)
Columns("B").Clear
Range(rngStart, rngEnd).Offset(0, 1).Value = "X"
End Sub

Private Sub cmdOK_Click()

Dim txt As String
txt = InputBox("Textbox'a Aktaracağınız Metni yazın:", , "www.kod.gen.tr")
If txt = "" Then End
gtxtBox.Text = txt
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set gtxtBox = Controls("TextBox1")
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set gtxtBox = Controls("TextBox2")
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set gtxtBox = Controls("TextBox3")
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set gtxtBox = Controls("TextBox4")
End Sub

Private Sub cmdOK_Click()

Dim var As Variant
Dim intRow As Integer
var = Application.Match(CDbl(txtValue.Text), Columns(1), 0)
If Not IsError(var) Then
MsgBox "Bu Sayı Daha Önce Girilmiş!"
Else
intRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(intRow, 1) = txtValue.Text
End If
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdOK_Click()

Dim iCounter As Integer
Dim sTag As String
Rows(1).Clear
For iCounter = 1 To 3
sTag = Controls("CommandButton" & iCounter).Tag
Cells(1, iCounter).Value = Controls("TextBox" & iCounter).Text
If sTag <> "False" And sTag <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:=Cells(1, iCounter), _
Address:=sTag
End If
Next iCounter
Unload Me
End Sub

Private Sub CommandButton1_Click()
CommandButton1.Tag = SelectPicture
End Sub

Private Sub CommandButton2_Click()
CommandButton2.Tag = SelectPicture
End Sub

Private Sub CommandButton3_Click()
CommandButton3.Tag = SelectPicture
End Sub

Private Function SelectPicture()
Dim var As Variant
var = Application.GetOpenFilename("İzin Verilen Formatlar (*.gif), *.gif")
If var = False Then
SelectPicture = "False"
Else
SelectPicture = var
End If
End Function

Private Sub txtValue_Change()

Dim arr() As Variant
Dim iRow As Integer, iCol As Integer, iCounter As Integer
If txtValue.TextLength = 4 Then
iRow = 2
Do Until IsEmpty(Cells(iRow, 1))
If Cells(iRow, 1) = txtValue.Text Then
iCounter = iCounter + 1
ReDim Preserve arr(1 To 4, 1 To iCounter)
For iCol = 1 To 4
arr(iCol, iCounter) = Cells(iRow, iCol).Value
Next iCol
End If
iRow = iRow + 1
Loop
lstValues.Column = arr
End If
End Sub

Private Sub cmdOK_Click()

Dim sPath As String, sFile As String, sWks As String
Dim sRange As String
sPath = "c:\test"
sFile = "test.xls"
sWks = "Sayfa1"
sRange = "askin"
If Dir(sPath & "\" & sFile) = "" Then
Beep
MsgBox "Tarih " & sFile & " "
Exit Sub
End If
On Error Resume Next
Range("IV1").Formula = "='" & sPath & _
"\[" & sFile & "]" & sWks & "'!" & sRange
txtImport.Text = Range("IV1").Value
Range("IV1").ClearContents
End Sub

Private Sub cmdOK_Click()


If TextBox1.Text <> "" Then
Range("A1").Value = Range("A1").Value + CDbl(TextBox1.Text)
End If
If TextBox2.Text <> "" Then
Range("B3").Value = Range("B3").Value + CDbl(TextBox2.Text)
End If
If TextBox3.Text <> "" Then
Range("C6").Value = Range("C6").Value + CDbl(TextBox3.Text)
End If
End Sub

Private Sub TextBox1_Exit _
(ByVal Cancel As MSForms.ReturnBoolean)

If TextBox1.Value <> "Aşkın" Then
MsgBox "Yanlış Veri"
TextBox1.SetFocus
Cancel = True
End If
End Sub

Private Sub TextBox1_Exit _
(ByVal Cancel As MSForms.ReturnBoolean)

If Len(TextBox1.Text) > 5 Then
MsgBox "Fazla Karakter Girdiniz"
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
End If
End Sub

Private Sub CommandButton1_Click()

Dim i As Integer
For i = 1 To 3
Cells(1, i) = Controls("Textbox" & i)
Next i
End Sub

Private Sub CommandButton1_Click()

Dim temp, temp1

temp = TextBox1.Value
temp1 = IIf(Application.CountIf(Columns(1), temp) > 0, 1, 0)

If temp1 > 0 And TextBox1.Value <> "" Then
MsgBox "Aynı Kayıttan Bulundu"
Else
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = temp
End If
End Sub

textboxtaki değer mesala 56,50 ise bunu 57veya 56,49 ise bunu 56 olarak nasıl göstere bilirim.Bunu sağlayabilecek bir Function arıyom

TextBox1.Value = Round(TextBox1.Value, 0)
TextBox1.Value = CLng(TextBox1.Value)

Private Sub TextBox1_Exit _
(ByVal Cancel As MSForms.ReturnBoolean)
'Eğer Textboxsa sizin istediğiniz değer girilmezse textboxtan çıkılamaz
If TextBox1.Value <> "Aşkın" Then
MsgBox "Yanlış Veri"
TextBox1.SetFocus
Cancel = True
End If
End Sub

Private Sub TextBox1_Exit _
(ByVal Cancel As MSForms.ReturnBoolean)
‘textbox taki veri 5 karekterden fazla olursa kabul edilmez
If Len(TextBox1.Text) > 5 Then
MsgBox "Fazla Karakter Girdiniz"
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
End If
End Sub

Kaynak: Excel vba Örnek Dosyalar Cd'si

msgbox özellikleri, (mesaj kutuları)

Function FileOrFolderName(InputString As String, _
ReturnFileName As Boolean) As String

Dim i As Integer, FolderName As String, FileName As String
i = 0
While InStr(i + 1, InputString, Application.PathSeparator) > 0
    i = InStr(i + 1, InputString, Application.PathSeparator)
Wend
If i = 0 Then
    FolderName = CurDir
Else
    FolderName = Left(InputString, i - 1)
End If
FileName = Right(InputString, Len(InputString) - i)
If ReturnFileName Then
    FileOrFolderName = FileName
Else
    FileOrFolderName = FolderName
End If
End Function

Sub TestFileOrFolderName()
‘cdrom sürücüleri msgboxta gösterir
MsgBox FileOrFolderName(ThisWorkbook.FullName, False), , _
    "This Workbook Foldername:"
MsgBox FileOrFolderName(ThisWorkbook.FullName, True), , _
    "This Workbook Filename:"
End Sub
________________________________________
Sub goster()
‘Hücre Değerinin Msgbox ta gösterilmesi
Dim veri As String
veri = Cells(8, 5).Value '8. satır 5. sütun
MsgBox ("Şu Anda E8 Hücresinde" + vbNewLine + veri _
+ vbNewLine + "Değeri var")
'vbNewline bir alt satıra indirir.
'chr(13)+chr(10) da yazılabilir
End Sub
________________________________________
Sub Düğme1_Tıklat()
'vbDefaultButton2 parametresi ile aktif olacak buttonun "Hayır"
'olacağını belirtiyoruz. Buylece klavyeden Enter
'tuşuna basılınca tıklanan (ilk olarak) düğmeyi belirleR

Dim Mesaj As String
Mesaj = MsgBox("Program Kapatılsınmı?", vbYesNo + _
vbCritical + vbDefaultButton2) 'ikinci button aktif olsun
If Mesaj = vbYes Then
Application.Quit
Else
MsgBox ("Kapatma İşlemi iptal Edildi"), , "www.kod.gen.tr"
End If
End Sub
________________________________________
Sub Düğme1_Tıklat()
'Mesaj kutusu en üste
'vbSystemModal; (varsayılan VbApplicationModal dir) Parametresi çalışan
'diğer uygulamaların (Notepad veya calc veya başka form)
'mesaj penceresini kapatıp (üste gelme) kapatamıyacağını belirler

Dim Mesaj As String
Mesaj = MsgBox("Program Kapatılsınmı?", vbYesNo + _
vbCritical + vbDefaultButton2 + vbSystemModal)
If Mesaj = vbYes Then
Application.Quit
Else
MsgBox ("Kapatma İşlemi iptal Edildi"), , "www.kod.gen.tr"
End If
End Sub
________________________________________
Sub Düğme1_Tıklat()
‘İkili mesaj kutusu (evet hayır)
Dim Mesaj As String
Mesaj = MsgBox("www.kod.gen.tr", vbYesNo)
If Mesaj = vbYes Then
MsgBox ("Evet Düğmesine Tıkladınız"), , "www.kod.gen.tr"
Else
MsgBox ("Hayır Düğmesini Tıkladınız"), , "www.kod.gen.tr"
End If
End Sub
________________________________________
Sub Düğme1_Tıklat()
'İkonlar için kullanılabilecek Seçinekler
'Vbquestion (Soru İkonu)
'vbInformation
'VbExclamation (Dikkat Ünlem İkonu)
'VbCritical (çarpı ikonu Tehlike)
Dim Mesaj As String
Mesaj = MsgBox("www.kod.gen.tr", vbYesNo + vbQuestion)’resimler burada
If Mesaj = vbYes Then
MsgBox ("Evet Düğmesine Tıkladınız"), , "www.kod.gen.tr"
Else
MsgBox ("Hayır Düğmesini Tıkladınız"), , "www.kod.gen.tr"
End If
End Sub
________________________________________
Sub MessageBox3()
' Birdan fazla satırlı msgbox. vbCrLf alt satıra indirir
Dim strMessage As String
strMessage = "Kategorilerle Vba Cd'si" & vbCrLf & "www.kod.gen.tr" & vbCrLf & "A.Aşkın KÜÇÜKKAYA"
MsgBox strMessage
End Sub

________________________________________
Private Sub Workbook_Deactivate()
‘Kodları ThisWorkbook’a yazınız
'Kapanışta Selam
MsgBox ("Yine Bekleriz" & vbCrLf & "Güle Güle"), , "http://www.kod.gen.tr"
End Sub

Private Sub Workbook_Open()
'açılışta selam
MsgBox ("Merhaba Hoşgeldiniz" & vbCrLf & "Kolay Gelsin"), , "http://www.kod.gen.tr"
End Sub
________________________________________
Sub Test()
'Sayfa1.hücreB2:J2 aralığını mesaj kutusunda gösterimi
Dim Email As String, Subj As String
Dim Msg As String, url As String
Dim Vin As String
Dim r As Integer, x As Double
For r = 2 To 2

Email = Cells(r, 1)
' Mesajın Konusu
Subj = "Sayfanızdaki yazılar"

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sayfa1").Range("B1:J1")
strbody = strbody & cell.Value & " , "

Dim cell2 As Range
Dim grades As String
For Each cell2 In ThisWorkbook.Sheets("Sayfa1").Range("B2:J2")
grades = grades & cell.Value & " , "

Next
Next
' Mesajı oluştur
Range("A1").Select
Msg = ""
Msg = "Sevgili " & Cells(r, 1) & "," & vbCrLf & vbCrLf _
& "Aşağıda sizin belirttiğiniz aralığa ait yazılar bulunmaktadır." & vbCrLf & vbCrLf _
& strbody & ", " & grades & ", " & Cells(r, 2).Text & ", " _
& Cells(r, 3).Text & ", " & Cells(r, 4).Text & ", " _
& Cells(r, 5).Text & ", " & Cells(r, 6).Text & ", " _
& Cells(r, 7).Text & ", " & Cells(r, 8).Text & ", " _
& Cells(r, 9).Text & ", " & vbCrLf & Cells(r, 10).Text & ", " _
& Cells(r, 11).Text & vbCrLf & "Eric Duchin" & " www.kod.gen.tr"

MsgBox Subj & Chr(13) & Msg
Next
End Sub
________________________________________
Sub test()
'mesaj kutusu 10 saniye sonra çalışır
If Application.Wait(Now + TimeValue("0:00:10")) Then
MsgBox "Zaman Sona Erdi"
End If
End Sub