msgbox özellikleri, (mesaj kutuları)

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