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


hücredeki sayı kadar çıktı almak

ID : 1089
ISLEM : hücredeki sayı kadar çıktı almak
MAKRO KODU : Private Sub CommandButton1_Click() Sheets("Sayfa1").PrintOut From:=1, To:=[A1].Value ‘TextBox1.value olursa textboxtali sayı kadar çıktı alınır End Sub

hücredeki sayı kadar yazıcıdan çıktı alma

ID : 1090
ISLEM : hücredeki sayı kadar yazıcıdan çıktı alma
MAKRO KODU : Sub ImprimFormulaire() Dim CellPara Range("A2") = Application.InputBox(prompt:="Taper le nombre de copies que vous désirez.", Type:=1) For CellPara = 1 To Range("A2") Range("E13").Value = Range("E13").Value + 1 ActiveSheet.PageSetup.PrintArea = "$A$5:$I$24" ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next End Sub

hücredeki sayının son rakamını 0 (sıfır) yapar

ID : 1091
ISLEM : hücredeki sayının son rakamını 0 (sıfır) yapar
MAKRO KODU : Sub Round() ActiveCell = Application.Round(ActiveCell, -3) End Sub

hücredeki sayıyı alt veya üst karaktere ve normale çevirir. h2o, co2

ID : 1092
ISLEM : hücredeki sayıyı alt veya üst karaktere ve normale çevirir. h2o, co2
MAKRO KODU : Sub ZahlHoch() Dim r As Range Dim i As Integer For Each r In Selection.Cells If r.Value <> Empty Then For i = 1 To Len(r.Value) If IsNumeric(Mid(r.Value, i, 1)) Then r.Characters(i, 1).Font.Superscript = True Else r.Characters(i, 1).Font.Superscript = False End If Next End If Next End Sub Sub ZahlTief() Dim r As Range Dim i As Integer For Each r In Selection.Cells If r.Value <> Empty Then For i = 1 To Len(r.Value) If IsNumeric(Mid(r.Value, i, 1)) Then r.Characters(i, 1).Font.Subscript = True Else r.Characters(i, 1).Font.Subscript = False End If Next End If Next End Sub Sub ZahlNormal() Dim r As Range Dim i As Integer For Each r In Selection.Cells If r.Value <> Empty Then For i = 1 To Len(r.Value) If IsNumeric(Mid(r.Value, i, 1)) Then r.Characters(i, 1).Font.Superscript = False r.Characters(i, 1).Font.Subscript = False End If Next End If Next End Sub

hücredeki sayıyı bir üst binliğe tamamlar

ID : 1093
ISLEM : hücredeki sayıyı bir üst binliğe tamamlar
MAKRO KODU : Sub son() ActiveCell = Application.Ceiling(ActiveCell, 1000) End Sub

hücredeki sayıyı bulma

ID : 1094
ISLEM : hücredeki sayıyı bulma
MAKRO KODU : Function sayim(hucre) Dim i As Integer For i = 1 To Len(hucre) sayi = Mid(hucre, i, 1) If IsNumeric(sayi) = True Then sayim = sayim & sayi End If Next i End Function

hücredeki sayıyı kendi binliğine 0 sıfırlar

ID : 1095
ISLEM : hücredeki sayıyı kendi binliğine 0 sıfırlar
MAKRO KODU : Sub bin() ActiveCell = Application.Floor(ActiveCell, 1000) End Sub

hücredeki veri kadar sütunda genişlik (otomatik)

ID : 1096
ISLEM : hücredeki veri kadar sütunda genişlik (otomatik)
MAKRO KODU : Thisworkbook a Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range) x = Target.Row y = Target.Column ActiveSheet.Rows(x).AutoFit ActiveSheet.Columns(y).AutoFit End Sub

hücredeki veri mesaj kutusunda 1

ID : 1097
ISLEM : hücredeki veri mesaj kutusunda 1
MAKRO KODU : Sub Düğme1_Tıklat() Set s1 = Sheets("Sayfa2") For i = 1 To 100 s1.Cells(i, 1).Activate s1.Rows(i + 1 & ":" & i + 32).Select Selection.Insert Shift:=xlDown i = i + 32 Next i End Sub

hücredeki veri mesaj kutusunda 2

ID : 1098
ISLEM : hücredeki veri mesaj kutusunda 2
MAKRO KODU : Sub Mesaj() Dim Mes As String Dim i As Integer For i = 6 To 48 Step 2 Mes = Mes & Format(Range("A" & i), "0##,##0") _ & vbTab & Format(Range("B" & i), "0##,##0") & vbCrLf Next i MsgBox Mes End Sub

hücredeki verinin diğer sayfada altbilgi olarak gözükmesi

ID : 1099
ISLEM : hücredeki verinin diğer sayfada altbilgi olarak gözükmesi
MAKRO KODU : Sheets(1).PageSetup.CenterFooter = Sheets(2).[A1]

hücredeki veriyi txtboxta göstermek 1

ID : 1100
ISLEM : hücredeki veriyi txtboxta göstermek 1
MAKRO KODU : Private Sub UserForm_Activate() i=1 For Each Hucre In Range("A5:F5") Controls("TextBox" & i) = Hucre i = i + 1 Next End Sub

hücredeki veriyi txtboxta göstermek 2

ID : 1101
ISLEM : hücredeki veriyi txtboxta göstermek 2
MAKRO KODU : Private Sub UserForm_Activate() range("a4").select For i = 1 To 7 Controls("Textbox" & i).Value = activecell.offset(i,0).Value Next End Sub

hücredeki yazı tersinden

ID : 1102
ISLEM : hücredeki yazı tersinden
MAKRO KODU : Sub ReverseText() Dim strText As String, strReverseText As String Dim intPos As Integer, intLen As Integer strText = Selection.Text intLen = Len(strText) For intPos = 1 To Len(strText) strReverseText = strReverseText & Mid(strText, intLen - intPos + 1, 1) Next intPos ActiveCell.FormulaR1C1 = strReverseText End Sub

hücredeki yazi karakterinin rengine göre filtreleme

ID : 1103
ISLEM : hücredeki yazi karakterinin rengine göre filtreleme
MAKRO KODU : Aşağıdaki kodu kopyala ve sayfaya yapıştır. Function renkkodu(hucre As Range) hucre1 = hucre.Address(ColumnAbsolute:=False, RowAbsolute:=False) renkkodu = Range(hucre1).Font.ColorIndex End Function Kaydet ve Editörü kapat. Renkkodu adında yeni bir fonksiyon yaratmış olduk. Toblonun en sağındaki hücrelere =renkkodu(adres) yaz (adres rengine göre filtreleme yapacağın hücre) Aynı formülü tablonun tüm satırlarına karşılık gelecek şekilde kopyala. Böylece sözkonusu hücrenin renk kodunu yazdırmış olduk. Ã imdi bu kolon üzerinden istediğin renk koduna göre filtre yapabilirsin. Biraz özgün bir çözüm oldu, umarım işine yarar. Başka kullanıcılardan farklı öneriler de gelebilir sanırım.

hücredekine göre hücre temizleme

ID : 1104
ISLEM : hücredekine göre hücre temizleme
MAKRO KODU : Sub SİL() Sheets("Sayfa1").Select Set ALAN1 = [A2] 'A5:E10 örnek Set ALAN2 = [B2] ' If ALAN1 <> "" Then Sheets("Sayfa1").Range(ALAN1).ClearContents If ALAN2 <> "" Then Sheets("Sayfa2").Range(ALAN2).ClearContents Sheets("Sayfa1").Select MsgBox "İŞLEM TAMAMLANMIŞTIR.", vbInformation End Sub

hücreler arasına tıklayınca userform çıkar

ID : 1105
ISLEM : hücreler arasına tıklayınca userform çıkar
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim RaBereich As Range Set RaBereich = Range("B3:C20,D1:D7") If Not Intersect(Range(Target.Address), RaBereich) Is Nothing Then UserForm1.Show Set RaBereich = Nothing End Sub

hücreler arasını seçer ve yakınlaştırır

ID : 1106
ISLEM : hücreler arasını seçer ve yakınlaştırır
MAKRO KODU : Sub screen_opt() Range("A1:N29").Select ActiveWindow.Zoom = True Range("A1").Select End Sub

hücreler boş geçilemez b1:b8

ID : 1107
ISLEM : hücreler boş geçilemez b1:b8
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B1:B8")) Is Nothing Then Exit Sub If row <> 0 Then If Cells(row, col) = "" And Target.row <> row Then MsgBox ("boş geçemezsiniz") Cells(row, col).Select Exit Sub End If End If If Target.row <> row Then row = Target.row col = Target.Column End If End Sub

hücreler renkli yanip söner

ID : 1108
ISLEM : hücreler renkli yanip söner
MAKRO KODU : A1 İLE M8 HÜCRELERİN ARKASINDA YEŞİL IŞIK 10 DEFA YANAR SÖNER Sub FlashBack() Dim newColor As Integer Dim myCell As Range Dim x As Integer Dim fSpeed Set myCell = Range("A1:M8") Application.DisplayStatusBar = True Application.StatusBar = "... Select Cell to Stop and Edit or Wait for Flashing to Stop! " newColor = 12 fSpeed = 0.2 Do Until x = 10 DoEvents Start = Timer Delay = Start + fSpeed Do Until Timer > Delay DoEvents myCell.Interior.ColorIndex = newColor Loop Start = Timer Delay = Start + fSpeed Do Until Timer > Delay DoEvents myCell.Interior.ColorIndex = xlNone Loop x = x + 1 Loop Application.StatusBar = False Application.DisplayStatusBar = Application.DisplayStatusBar End Sub

hücrelerde font, renk yazı tipi değiştirme

ID : 1109
ISLEM : hücrelerde font, renk yazı tipi değiştirme
MAKRO KODU : Sub fontrenk() Dim Cel1 As Range Set Cel1 = Range("A1:b10") With Cel1.Font .Bold = True .Italic = True .Name = "Courier" .Size = 10 .Color = RGB(255, 0, 0) End With End Sub

hücrelerde yuvarlama formülü 1

ID : 1110
ISLEM : hücrelerde yuvarlama formülü 1
MAKRO KODU : Sub yuvarla() Range("A3").Formula = Round((Range("a1").Value + Range("a2").Value) / 50000) * 50000 End Sub

hücredeki değeri 1 er artırarak yazdırma

ID : 1081
ISLEM : hücredeki değeri 1 er artırarak yazdırma
MAKRO KODU : Sub pay_wages() Dim counter counter = 1 Range("B3").Select Do While ActiveCell.Value < 10 ActiveCell.Value = counter ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True counter = counter + 1 Loop End Sub

hücredeki değeri birer artırarak yazdırma

ID : 1082
ISLEM : hücredeki değeri birer artırarak yazdırma
MAKRO KODU : Sub herartista_bir_kopya() Dim counter counter = 1 Range("B3").Select Do While ActiveCell.Value < 10 ActiveCell.Value = counter ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True counter = counter + 1 Loop End Sub

hücredeki değerlerin yazı tipi, fontu kalınlık

ID : 1083
ISLEM : hücredeki değerlerin yazı tipi, fontu kalınlık
MAKRO KODU : Range(“D3”).Font.Size=14 Range(“D3”).Font.Name=”Arial” Range(“D3”).Font.Bold=True gibi

hücredeki formülü değişen satir sayisi kadar kopyala

ID : 1084
ISLEM : hücredeki formülü değişen satir sayisi kadar kopyala
MAKRO KODU : Sub Test() x = Cells(65536, 3).End(xlUp).Row Range("E2").AutoFill Destination:=Range("E2:E" & x) Application.Calculate End Sub

hücredeki metne çevir olayını userformdan yapmak

ID : 1085
ISLEM : hücredeki metne çevir olayını userformdan yapmak
MAKRO KODU : Sub GunFormati() Yil = Sheets("MENÜ").Range("AA1") Ay = Sheets("MENÜ").Range("AA2") Gun = Range("D6") MsgBox Format(DateSerial(Yil, Ay, Gun), "dddd") End Sub

hücredeki otomatik tarih formati

ID : 1086
ISLEM : hücredeki otomatik tarih formati
MAKRO KODU : worksheet in change olayına visual basic kodu: -------------------------------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim blg As Range If Target.Count > 1 Then Exit Sub Set blg = Range("A:A") If Intersect(Target, blg) Is Nothing Then Exit Sub If Len(Target) = 8 Then If InStr(Target, ".") = 0 Then Target = Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Right(Target, 4) End If End Sub -------------------------------------------------------------------------------- kodunu eklerseniz, a sütununa bahsettiğiniz formatta girdiğiniz her tarih kısaltmasını istediğiniz formata çevirir.

hücredeki rakamlari harf karşiliklarina çevirme

ID : 1087
ISLEM : hücredeki rakamlari harf karşiliklarina çevirme
MAKRO KODU : lgili hücreleri seçtikten sonra; Kod: Sub Encrypt2() Dim Array1, Array2 Dim i As Integer Dim MyRng As Range Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z") Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0) For Each MyRng In Selection For i = LBound(Array1) To UBound(Array1) MyRng = WorksheetFunction.Substitute(MyRng, Array1(i), Array2(i)) Next Next End Sub ' Sub Decrypt2() Dim Array1, Array2 Dim i As Integer Dim MyRng As Range Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z") Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0) For Each MyRng In Selection For i = LBound(Array1) To UBound(Array1) MyRng = WorksheetFunction.Substitute(MyRng, Array2(i), Array1(i)) Next Next End Sub

hücredeki renge göre filtreleme

ID : 1088
ISLEM : hücredeki renge göre filtreleme
MAKRO KODU : Sayfanın kod bölümüne. Function renkkodu(hucre As Range) hucre1 = hucre.Address(ColumnAbsolute:=False, RowAbsolute:=False) renkkodu = Range(hucre1).Font.ColorIndex End Function 'Kaydet, kapat. 'Renkkodu adında yeni bir fonksiyon oluşturmuş olduk. 'Tablonun en sağındaki hücrelere '=renkkodu(adres) yaz (adres rengine göre filtreleme yapacağın hücre) 'Aynı formülü tablonun tüm satırlarına karşılık gelecek şekilde kopyala. 'Böylece sözkonusu hücrenin renk kodunu yazdırmış olduk. 'Şimdi bu kolon üzerinden istediğin renk koduna göre filtre yapabilirsin

* Görseller ve İçerik tekif hakkına sahip olabilir