Makro Kod Listesi

Excel de kullanılan Makro Kodlarının Listesi

ID : 2191
ISLEM : textboxta rakamın başına 0 sıfır ekleme
MAKRO KODU : Excele kayderkenKod: Cells(1,1) = "'" & textbox1.text Private Sub TextBox1_Change() TextBox1 = "0" & Format(TextBox1, "###,###") End Sub

ID : 2192
ISLEM : textboxta sağa yanaşık yazma
MAKRO KODU : TextBox1.TextAlign = fmTextAlignRight

ID : 2193
ISLEM : textboxta seslileri sayma
MAKRO KODU : Option Explicit Private Sub Command1_Click() Text2.Text = Seslisay(Text1.Text) End Sub Function Seslisay(Metin As String) As Integer Dim sayac, i As Integer Const Harfler = "aeıioöuü" For i = 1 To Len(Metin) If InStr(Harfler, LCase(Mid(Metin, i, 1))) <> 0 Then sayac = sayac + 1 End If Next i Seslisay = sayac End Function

ID : 2194
ISLEM : textbox'ta tam sayi örneği
MAKRO KODU : TextBox2 = cint(Sheets("9b").Cells(x, 7)) TextBox3 = cint(Sheets("9b").Cells(x, 8)).

ID : 2195
ISLEM : textboxta tarih formatı
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, "dd""/""mm""/""yyyy") End Sub

ID : 2196
ISLEM : textboxta tarih formatı 2
MAKRO KODU : Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If TextBox1.Text > "" Then If Not IsDate(TextBox1.Text) Then MsgBox "Tarih geçerli değil", vbInformation TextBox1.SetFocus Exit Sub End If End If End Sub

ID : 2197
ISLEM : textboxta tarih toplama
MAKRO KODU : Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) tarih = Calendar2.Value TextBox6 = DateSerial(Year(tarih), Month(tarih) + 6, Day(tarih)) End Sub

ID : 2198
ISLEM : textboxta tarih toplama çıkarma hatasız
MAKRO KODU : Dim Date1 As Date, Date2 As Date Dim yil As Integer, ay As Integer, gun As Integer Date1 = DateSerial(Year(Text1), Month(Text1), Day(Text1)) Date2 = DateSerial(Year(Text2), Month(Text2), Day(Text2)) Date2 = DateAdd("d", 1, Date2) 'BENİM EKLEDİĞİM SATIR yil = DateDiff("yyyy", Date1, Date2) ay = DateDiff("m", Date1, Date2) + (Day(Date1) > Day(Date2)) yil = yil + ((ay - yil * 12) < 0) ay = ay Mod 12 gun = DateDiff("d", Date1, Date2) - DateDiff("d", Date1, DateAdd("yyyy", yil, DateAdd("m", ay, Date1))) Text3 = yil & " yıl, " & ay & " ay ve " & gun & " gün."

ID : 2199
ISLEM : textboxta telefon formatı
MAKRO KODU : Private Sub TextBox1_Change() If Len(TextBox1.Text) < 10 Then TextBox1 = Replace(TextBox1, " ", "") Else TextBox1.Text = Format(TextBox1, "0(###) ### ## ##") End If End Sub

ID : 2200
ISLEM : textboxta telefon formatı 2
MAKRO KODU : Private Sub TextBox1_Change() If Len(TextBox1.Text) >= 16 Then TextBox1 = Left(TextBox1, 16) If Len(TextBox1.Text) < 10 Then TextBox1 = Replace(TextBox1, " ", "") Else TextBox1.Text = Format(TextBox1, "0(###) ### ## ##") End If End Sub

ID : 2201
ISLEM : textboxta telefon formatı 3
MAKRO KODU : Private Sub TextBox1_Change() If Len(TextBox1.Text) >= 15 Then TextBox1 = Left(TextBox1, 15) If Len(TextBox1.Text) < 10 Then TextBox1 = Replace(TextBox1, " ", "") Else TextBox1.Text = Format(TextBox1, "(###) ### ## ##") End If End Sub

ID : 2202
ISLEM : textboxta telefon numarası formatı
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, "(###)"".""###"".""##"".""##") End Sub

ID : 2203
ISLEM : textboxta toplama
MAKRO KODU : Private Sub TextBox3_Enter() TextBox3 = CInt(TextBox1) + CInt(TextBox2) End Sub veya Private Sub TextBox3_Enter() TextBox3 = Val(TextBox1) + Val(TextBox2) End Sub

ID : 2204
ISLEM : textboxta veri sınırlaması (max karakter)
MAKRO KODU : Private Sub CommandButton1_Click() TextBox1.MaxLength = 7 End Sub

ID : 2205
ISLEM : textboxta virgülden sonra 2 haneden fazla veya eksik veri girişini engelleme
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, "###,###.00") End Sub

ID : 2206
ISLEM : textboxta yazanı sayfada buldurma (tamamını yazmak şart)
MAKRO KODU : Private Sub CommandButton1_Click() Dim i As Byte If Len(TextBox1) > 0 Then For i = 1 To Worksheets.Count Call Myxxrt(Worksheets(i).Name) Next End If End Sub Private Function Myxxrt(ShName As String) Dim MyRng As Range On Error Resume Next Set MyRng = Range(Sheets(ShName).Cells.Find(TextBox1, LookAt:=xlWhole).Address) MsgBox "Aranılan değer " & ShName & " sayfasında " & MyRng.Address(False, False) & " hücresinde bulundu !" Set MyRng = Nothing End Function

ID : 2207
ISLEM : textboxta yazanların ilk harfleri büyük olur
MAKRO KODU : Public Function AutoType(c As Control, KeyAscii As Integer) As Integer AutoType = KeyAscii If KeyAscii > 95 And KeyAscii < 123 Then If c.SelStart = 0 Then AutoType = AutoType - 32 ElseIf Mid$(c.Text, c.SelStart, 1) < "!" Then AutoType = AutoType - 32 End If End If End Function Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = AutoType(Screen.ActiveControl, KeyAscii) End Sub

ID : 2208
ISLEM : textboxta ytl
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, ("##,###.## Ytl")) End Sub

ID : 2209
ISLEM : textboxtaki 1/1 excelde 1
MAKRO KODU : Hiçbir değişiklik yapmadan göstermesi lazım mesela A1 hücrenizde gözükecekse bu veri (A1 hücreniz genel olsun) aşağıdaki gibi yazabilirsiniz Private Sub TextBox6_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If TextBox6 Like "#" Then TextBox6 = TextBox6 & "/" Range("a1") = TextBox6 End Sub

ID : 2210
ISLEM : textboxtaki karakterleri seçme ok işaretiyle
MAKRO KODU : Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) On Error GoTo ErrHand: With TextBox1 If KeyCode = vbKeyLeft Or KeyCode = vbKeyBack Then KeyCode = vbKeySelect .SelStart = .SelStart - 1 .SelLength = 1 ElseIf KeyCode = vbKeyRight Then KeyCode = vbKeySelect .SelStart = .SelStart + 1 .SelLength = 1 ElseIf KeyCode = vbKeyDelete Then KeyCode = vbKeySelect If .SelText = "." Then .SelText = "." Else .SelText = "#" End If .SelStart = .SelStart - 1 .SelLength = 1 ElseIf KeyCode = vbKeyHome Then KeyCode = vbKeySelect .SelStart = 0 .SelLength = 1 ElseIf KeyCode = vbKeyEnd Then KeyCode = vbKeySelect .SelStart = Len(TextBox1) - 1 .SelLength = 1 End If End With Exit Sub ErrHand: KeyCode = vbKeySelect TextBox1.SelStart = 0 TextBox1.SelLength = 1 End Sub

ID : 2211
ISLEM : textboxtaki veriye göre süzme işlemi
MAKRO KODU : UserFormda TextBoxları açıyorsun.Diyelimki 5 tane.TextBox1,2....5.UserFormun Initialize kısmına Kod: Private Sub UserForm_Initialize() TextBox1.Text = Range("d5").Text TextBox2.Text = Range("d6").Text TextBox3.Text = Range("d7").Text TextBox4.Text = Range("d8").Text TextBox5.Text = Range("d9").Text End Sub

ID : 2212
ISLEM : textboxtaki yazının mesaj olarak bildirilmesi
MAKRO KODU : MsgBox TextBox1.Text & " İSİMLİ ŞAHISIN KAYDI GÜNCELLENMİŞTİR.", vbInformation + vbOKOnly, "KAYIT GÜNCELLENDİ"

ID : 2213
ISLEM : textboxtan çıkarken msgbox
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsNumeric(TextBox1) Then MsgBox "KAYDETMEKTE OLDUĞUNUZ KART BÖLÜM KARTIDIR. PERSONEL İÇİN BU KART KODUNUN ALTINDA PERSONEL KARTLARI AÇINIZ, DEVAM ETMEK İSTEDİĞİNİZDEN EMİN MİSİNİZ?", vbQuestion + vbYesNo End Sub

ID : 2214
ISLEM : textbox'u sesli okuma
MAKRO KODU : Tools>References bölümünden microsoft speech object library'i ekleyin 1 adet UserForm oluşturun 1 adet TextBox 1 adet CommanButton Dim konus As New SpeechLib.SpVoice Private Sub UserForm_Activate() TextBox1.Text = "buraya istediğini yaz" End Sub Private Sub CommandButton1_Click() konus.Speak TextBox1.Text End Sub

ID : 2215
ISLEM : textbox'un aktifleştirilmesi
MAKRO KODU : TextBox1.SetFocus

ID : 2216
ISLEM : timer mesaj örneği
MAKRO KODU : Sub timerMsg() Dim alertTime MsgBox "The alarm will go off in 3 seconds!" alertTime = Now + TimeValue("00:00:03") Application.OnTime alertTime, "msg" End Sub Sub msg() MsgBox "Three Seconds is up!" End Sub

ID : 2217
ISLEM : tl ve ytl
MAKRO KODU : Kod: Private Sub CommandButton1_Click() Unload Me End Sub Private Sub TextBox1_Change() On Error Resume Next TextBox1 = Format(TextBox1.Value, "#,##0") TextBox2.Value = Format(TextBox1.Value / 1000000, "#,##0.00") End Sub

ID : 2218
ISLEM : toggle button oluşturma ve komut
MAKRO KODU : Denetim Araç Kutusu (Control Toolbox) Araç Çubuğundan ToggleButton Private Sub ToggleButton1_Click() If ToggleButton1.Value = True Then ToggleButton1.Caption = "SİL" Range("A3") = Range("A1") + Range("A2") Else ToggleButton1.Caption = "TOPLA" Range("A3").ClearContents End If End Sub

ID : 2219
ISLEM : toolbar oluşturma
MAKRO KODU : Private Sub CommandButton1_Click() For i = 1 To 5 Toolbar1.Buttons.Add.Caption = i For x = 1 To 5 Toolbar1.Buttons(i).ButtonMenus.Add.Text = x Toolbar1.Buttons(i).Style = tbrDropdown Next x Next i End Sub

ID : 2220
ISLEM : topla formülünü yazar
MAKRO KODU : Option Explicit Sub AutoSum1() CommandBars.FindControl(ID:=226).Execute Application.SendKeys "~" End Sub Sub AutoSum2() With Application.CommandBars.FindControl(ID:=226) .Execute .Execute End With End Sub