Excel vba: kod

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()

    MsgBox FileOrFolderName(ThisWorkbook.FullName, False), , _
        "This Workbook Foldername:"
    MsgBox FileOrFolderName(ThisWorkbook.FullName, True), , _
        "This Workbook Filename:"
End Sub

‘Hücre Değerinin Msgbox ta gösterilmesi

Sub goster()
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

‘İkili mesaj kutusu (evet hayır)

Sub Düğme1_Tıklat()

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

Mesaj kutularına ikon eklemek

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

Mesaj kutularındaki satırları alt alta yazdırmak

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

Hücre aralıklarını mesaj kutusunda göstermek

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

Belirtilen süre doğrultusunda mesaj kutusu çalışır

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

Çalışma kitabınız kapatılınca mesaj kutusu açılır

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

Çalışma kitabınız ilk açıldığında mesaj kutusu açılır

Private Sub Workbook_Open()
'açılışta selam
MsgBox ("Merhaba Hoşgeldiniz" & vbCrLf & "Kolay Gelsin"), , "http://www.kod.gen.tr"
End Sub

KaynakExcel vba Örnek Dosyalar Cd'si

www.kod.gen.tr domaini bizdeyken hazırlamış olduğumuz örnek dosyaların üzerinde bu sitenin ismi yazmaktadır. şu anda yayında olan kod.gen.tr sitesiyle bir bağlantımız veya bağımız bulunmamaktadır.