Makro Kod Listesi

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

ID : 2131
ISLEM : textbox`daki yazinin hücreye aktarilmasi
MAKRO KODU : Private Sub TextBox1_Change() If Len(TextBox1.Text) > 14 Then MsgBox ("Karakter sayısı uzun") TextBox1.Enabled = False Else TextBox1.Enabled = True End If Label1.Caption = "Karakter sayı" & " " & Len(TextBox1.Text) & " " End Sub Private Sub UserForm_Click() End Sub

ID : 2132
ISLEM : textbox1 de arama textbox2 de bulma
MAKRO KODU : Private Sub TextBox1_Change() On Error Resume Next Satırno = Sheets("Sayfa1").[B2:B65536].Find(TextBox1.Value).Row TextBox2 = Sheets("Sayfa1").Cells(Satırno, 3).Value End Sub

ID : 2133
ISLEM : textbox1 e girilen bir isimle yeni çalişma sayfasi açma
MAKRO KODU : Private Sub CommandButton2_Click() If Not TextBox1 = Empty Then For i = 1 To Worksheets.Count If Sheets(i).Name = TextBox1 Then MyQ = MsgBox("Bu isimde bir şirket var, değişik bir isim girmelisiniz !") TextBox1 = Empty TextBox1.SetFocus Exit Sub End If Next Set NewSh = Worksheets.Add With NewSh .Name = TextBox1 .Range("A1") = Label2 .Range("A2") = Label3 .Range("A3") = Label4 .Range("A4") = Label5 .Range("B1") = TextBox2 .Range("B2") = TextBox3 .Range("B3") = TextBox4 .Range("B4") = TextBox5 .Range("B5") = TextBox6 .Columns("A:A").ColumnWidth = 12 .Columns("B:B").ColumnWidth = 34 .Columns("C:C").ColumnWidth = 19 .Columns("D:D").ColumnWidth = 19 End With End If With Range("A9:D9") With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin End With End With With Range("A1:D8") .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin End With .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone End With Set NewSh = Nothing End Sub

ID : 2134
ISLEM : textbox1'e tarih, textbox2'ye ay girdiğinizde sayfada bunun kesişimi olan değeri label'a yazar
MAKRO KODU : Ocak, Şubat, Mart...... gibi aylar A2:A13 aralığında, 1975, 1976,............... gibi yıllar B1:L1 aralığında, UserForm üzerinde TextBox1, TextBox2, Label1 ve CommandButton1 nesneleri varsa; Private Sub CommandButton1_Click() On Error GoTo ResumeSub: x = Range("A2:A13").Cells.Find(TextBox1).Row y = Range("B1:L1").Cells.Find(TextBox2).Column Label1.Caption = Cells(x, y) Exit Sub ResumeSub: Label1.Caption = "Deger bulunamadi...." End Sub

ID : 2135
ISLEM : textbox2 textbox1 den büyükse mesaj ver 1
MAKRO KODU : Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox1 <> 0 Then If TextBox1.Value < TextBox2 Then MsgBox "hata" TextBox2 = "" End if End If End Sub

ID : 2136
ISLEM : textbox2 textbox1 den büyükse mesaj ver 2
MAKRO KODU : Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox1 <> 0 And Val(TextBox1.Text) < Val(TextBox2.Text) Then MsgBox "hata":TextBox2 = "" End Sub

ID : 2137
ISLEM : textbox7'de veriler sağa yanaşik yazilsin.
MAKRO KODU : Userforma aşağıdaki kodu yazın. visual basic kodu: -------------------------------------------------------------------------------- Private Sub UserForm_Initialize() TextBox7.TextAlign = fmTextAlignRight End Sub

ID : 2138
ISLEM : textboxa alfabetik, backspace ve spacebar a izin verir
MAKRO KODU : Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If (Asc(UCase(Chr(KeyAscii))) < 65 Or Asc(UCase(Chr(KeyAscii))) > 91) And KeyAscii <> 8 And KeyAscii <> 32 Then KeyAscii = 0 End If End Sub

ID : 2139
ISLEM : textboxa çift tıklama ile form açılması
MAKRO KODU : Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) UserForm2.Show End Sub

ID : 2140
ISLEM : textbox'a girerken her üç rakamın arasına bir nokta koyma
MAKRO KODU : Bir UserForm üzerine 3 adet TextBox nesnesi ve 1 adet CommandButton nesnesi yerleştirin. Aşağıdaki kodları UserForm'unuza kopyalayın. Private Sub CommandButton1_Click() Dim t1 As Double Dim t2 As Double t1 = TextBox1.Value t2 = TextBox2.Value TextBox3 = t1 + t2 End Sub Private Sub TextBox1_Change() TextBox1 = Format(TextBox1, "###,0") End Sub Private Sub TextBox2_Change() TextBox2 = Format(TextBox2, "###,0") End Sub

ID : 2141
ISLEM : textboxa harf girilince ses çıkarsın
MAKRO KODU : Sub TextBox1_change() Dim N$ N = "0123456789." If KeyAscii <> 8 Then If InStr(N, Chr(KeyAscii)) = 0 Then Beep KeyAscii = 0 Exit Sub End If End If End Sub

ID : 2142
ISLEM : textboxa numerik girmeye zorlama
MAKRO KODU : Private Sub TextBox1_Change() If Len(TextBox1.Text) = 0 Then Exit Sub If Not IsNumeric(TextBox1.Text) Then Beep MsgBox "Numerik olmayan bir değer girdiniz" End If End Sub

ID : 2143
ISLEM : textboxa numerik ve backspace e izin verir
MAKRO KODU : Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If IsNumeric(Chr(KeyAscii)) = False And KeyAscii <> 8 Then KeyAscii = 0 End If End Sub

ID : 2144
ISLEM : textboxa rakam gir sonucu labelde gör
MAKRO KODU : Private Sub txtkalper_Change() labtopkalper = Val(txtsevper) * 0.4 + Val(txtkalper) * 0.6 End Sub

ID : 2145
ISLEM : textboxa rakam girmeye zorlamak
MAKRO KODU : Sub hesaplama() zamoranı: z = InputBox("Zam oranını giriniz ! Ondalık kısmı varsa virgülle ayırınız !") If Not IsNumeric(z) Then GoTo zamoranı Cells(1, 23) = (z + 100) / 100 End Sub

ID : 2146
ISLEM : textboxa sadece harf girilmesi
MAKRO KODU : Private Sub TextBox1_Change() If TextBox1 = "" Then Exit Sub deg = Mid(TextBox1.Value, Len(TextBox1.Value), 1) If IsNumeric(deg) = True Then MsgBox "SADECE HARF GİRİNİZ" TextBox1 = Mid(TextBox1.Value, 1, Len(TextBox1.Value) - 1) TextBox1.SetFocus End If End Sub

ID : 2147
ISLEM : textboxa sadece nokta veya virgül girmek
MAKRO KODU : Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 190 Then MsgBox ("Nokta yerine (.) Virgül (,) kullanın") End If End Sub

ID : 2148
ISLEM : textboxa sadece numara
MAKRO KODU : If Not IsNumeric(TextBox1) Then SendKeys "{BS}"

ID : 2149
ISLEM : textboxa sadece rakam girme
MAKRO KODU : Userformun code bölümüne yapıştır,textbox'ları çoğaltabilirsin kopyala yapıştır,makrodaki textbox1'i 2,3,4 gibi değiştir(userformdaki textbox sayısına göre) Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0: MsgBox " Harf girilmeyecek,Sadece Rakam Giriniz ....." End Sub

ID : 2150
ISLEM : textboxa sadece rakam girme-karakter sınırlı-boş geçemez
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Girilen değer numerik değilse Textboxten çıkışı engelliyor, bu durumda boşta olamıyor. If IsNumeric(TextBox1.Value) Then Cancel = False Else Cancel = True Beep ' 'beep' sesi üretiyor MsgBox ("Sadece sayı girin!") ' Uyarı penceresi açıyor. End If End Sub Private Sub UserForm_Initialize() TextBox1.MaxLength = 8 End Sub

ID : 2151
ISLEM : textboxa sadece rakam ve virgül
MAKRO KODU : Private Sub TextBox1_Change() If Not IsNumeric(TextBox1) Then SendKeys "{BS}" End Sub

ID : 2152
ISLEM : textboxa sadece rakam ve virgül
MAKRO KODU : Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End Sub

ID : 2153
ISLEM : textboxa şarta bağli veri girişi
MAKRO KODU : Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox3 <> "" Then If Val(TextBox3) > Val(TextBox2) Then Select Case MsgBox("Textbox 2 den büyük veri girişine izin verilsin mi...!", vbYesNo Or vbInformation Or vbSystemModal Or vbMsgBoxRight Or vbDefaultButton2, "yüksek rakamlı veri girişi") Case vbYes TextBox3.Value = Format(TextBox3.Value, "#,##0.00") TextBox2.Value = Format(TextBox2.Value, "#,##0.00") TextBox4.SetFocus Case vbNo Cancel = True TextBox3.Value = "" End Select End If End If End Sub

ID : 2154
ISLEM : textboxa tarih yazdirma
MAKRO KODU : TextBox1.Text = Format(DTPicker1, "dd.mm.yyyy")

ID : 2155
ISLEM : textboxa tıklandığında içeriğin tümünü seçmek
MAKRO KODU : Private Sub Text1_GotFocus() ' textbox aktif olduğunda Screen.ActiveControl.SelStart = 0 ' başlangıcı 0 olarak ata Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text) ' uzunluğu textboxınkine eşitle End Sub

ID : 2156
ISLEM : textboxa veri girmeye zorlamak
MAKRO KODU : Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox1.Value < 1 Or TextBox1.Value > 12 Then MsgBox "Hata oldu n'apcaz şimdi. Elbette Exit olayının Cancel argümanını kullanacaz" Cancel = True End If TextBox1 = "" End Sub

ID : 2157
ISLEM : textboxa veri kopyalama
MAKRO KODU : TEK BOK 1'İ KESER (BAŞKA YERE YAPIŞTIRMAK İÇİN) Private Sub CommandButton2_Click() TextBox1.Cut End Sub 'TEK BOKA VERİ YAPIŞTIRIR Private Sub CommandButton7_Click() TextBox11.Paste End Sub

ID : 2158
ISLEM : textboxa yazılan verinin hücreye aktarılması
MAKRO KODU : Private Sub TextBox1_Change() [a2] = TextBox1.Text End Sub

ID : 2159
ISLEM : textboxa yazıyı yazar yazmaz hesaplama
MAKRO KODU : Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Label2.Caption = KeyCode TextBox1.Value = "" End Sub

ID : 2160
ISLEM : textbox'a(metin kutusuna) girlilen yazının para birimi şeklinde olması
MAKRO KODU : TextBox nesnesinden "cursor - imleç" çıktığında bu işin yapılmasını istersen; Kod: Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, "#,### TL") End Sub Private Sub TextBox1_Change() RefreshTxtBx End Sub veya şöyle olabilir. Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, "#,### TL") End Sub ' Private Sub TextBox2_Change() RefreshTxtBx End Sub ' Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox2 = Format(TextBox2, "#,### TL") End Sub ' Private Sub RefreshTxtBx() Dim Val1 As Double, Val2 As Double On Error Resume Next Val1 = TextBox1 Val2 = TextBox2 On Error GoTo 0 TextBox3 = Format(Val1 + Val2, "#,### TL") End Sub