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


a1 e her veri girişinde b1,c1 sırasıyla hep yan kolona artarak yazar

ID : 91
ISLEM : a1 e her veri girişinde b1,c1 sırasıyla hep yan kolona artarak yazar
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Then Set actcell = [C1] Do While actcell "" Set actcell = actcell.Offset(0, 1) Loop actcell.Value = Target.Value End If End Sub -

a1 e kullanıcı adını yazdırma

ID : 92
ISLEM : a1 e kullanıcı adını yazdırma
MAKRO KODU : Sub Username() Range("A1").Value = Environ("USERNAME") End Sub

a1 e mail linki vermek ve outloook’u a1 deki maille açma

ID : 93
ISLEM : a1 e mail linki vermek ve outloook’u a1 deki maille açma
MAKRO KODU : Sub HyperlinkEmail() Range("A1").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="mailto:mahmut_bayram38@hotmail.com" End Sub Sub HyperlinkAktive() Range("A1").Select Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True End Sub

a1 e mesajla veri girme ve mesaj kutusunda a1 deki veriyi görme

ID : 94
ISLEM : a1 e mesajla veri girme ve mesaj kutusunda a1 deki veriyi görme
MAKRO KODU : Sub Vorschlagwert_in_InputBox() Dim vorschlag As String vorschlag = InputBox("Geben Sie bitte einen Namen ein", "Name", Range("A1").Value) If vorschlag = "" Then Exit Sub Range("A1").Value = vorschlag End Sub

a1 e sadece rakam girer (yazı girince 0 yapar) ve devamlı a1 de toplar

ID : 95
ISLEM : a1 e sadece rakam girer (yazı girince 0 yapar) ve devamlı a1 de toplar
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Static dAccumulator As Double With Target If .Address(False, False) = "A1" Then If Not IsEmpty(.Value) And IsNumeric(.Value) Then dAccumulator = dAccumulator + .Value Else dAccumulator = 0 End If Application.EnableEvents = False .Value = dAccumulator Application.EnableEvents = True End If End With End Sub

a1 e tarihi gir b1 de kaçıncı hafta olduğunu bulsun

ID : 96
ISLEM : a1 e tarihi gir b1 de kaçıncı hafta olduğunu bulsun
MAKRO KODU : B1 e aşağıdaki formülü gir =NSAT((A1-HAFTANINGÜNÜ(A1;2)-TARİH(YIL(A1+4-HAFTANINGÜNÜ(A1;2));1;-10))/7)

a1 e veri girildikten sonra 100 e bölünmesi

ID : 97
ISLEM : a1 e veri girildikten sonra 100 e bölünmesi
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Application.EnableEvents = False If Target.AddressLocal = "$A$1" Then Target = Target / 100 End If Application.EnableEvents = True End Sub

a1 e veri yazılınca solda üstbilgi ekleme

ID : 98
ISLEM : a1 e veri yazılınca solda üstbilgi ekleme
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If (Target = Range("A1")) Then Worksheets("Tabelle1").PageSetup.LeftHeader = Range("A1") End If End Sub

a1 e yaz b1 de devamlı toplasın

ID : 99
ISLEM : a1 e yaz b1 de devamlı toplasın
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) With Target If .Address(False, False) = "A1" Then If IsNumeric(.Value) Then Application.EnableEvents = False Range("B1").Value = Range("B1").Value + .Value Application.EnableEvents = True End If End If End With End Sub

a1 e yazılan (i) harfinin 90 derece yatık olması

ID : 100
ISLEM : a1 e yazılan (i) harfinin 90 derece yatık olması
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Target, Range("A1")) Is Nothing Then Target.Orientation = 0 If Target = "I" Then Target.Orientation = 90 End If End If End Sub

a1 hücre ismiyle farklı kaydetme

ID : 101
ISLEM : a1 hücre ismiyle farklı kaydetme
MAKRO KODU : Sub saveas() ActiveWorkbook.SaveAs Filename:="C:\" & ActiveSheet.Range("A1") End Sub

a1 hücresi boşsa kaydetme

ID : 102
ISLEM : a1 hücresi boşsa kaydetme
MAKRO KODU : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Sheets("Sayfa1").Range("A1") = "" Then MsgBox ("Kaydetme işlemi devam edemiyor!" & vbNewLine & _ "A1 hücresini boş bırakamazsınız."), , "pir" Cancel = True End If End Sub

a1 hücresi dolu ise d1 gizle, boş ise göster

ID : 103
ISLEM : a1 hücresi dolu ise d1 gizle, boş ise göster
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Columns("A:A") "" Then Columns("D:D").EntireColumn.Hidden = True Else Columns("D:D").EntireColumn.Hidden = False End If End Sub -

a1 hücresinde saat

ID : 104
ISLEM : a1 hücresinde saat
MAKRO KODU : Dim stopit As Boolean 'on top of module! Sub startclock() 'assign start button stopit = False clock End Sub Sub clock() If stopit = True Then Exit Sub ActiveWorkbook.Worksheets(1).Cells(1, 1).Value = _ Format(Now, "hh:mm:ss") Application.OnTime (Now + TimeSerial(0, 0, 1)), "clock" End Sub Sub stopclock() 'assign stop button stopit = True End Sub

a1 hücresindeki isimle sayfayı istenilen yere kaydetme

ID : 105
ISLEM : a1 hücresindeki isimle sayfayı istenilen yere kaydetme
MAKRO KODU : Sub Enreg_Fichier() Dim NomFichier As String NomFichier = Range("A1") ActiveWorkbook.SaveAs "c:\excel\" & NomFichier End Sub

a1 hücresindeki isimle yeni sayfa

ID : 106
ISLEM : a1 hücresindeki isimle yeni sayfa
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" And Target.Value = 1 Then Dim sayfa As Worksheet Dim önek As String Dim sonek As Integer Set Sayfam = Worksheets.Add önek = "Sayfam" SonEkim = 1 On Error Resume Next Sayfam.Name = önek & sonek If Err.Number 0 Then önek = sonek + 1 Sayfam.Name = önek & sonek End If End If End Sub -

a1 hücresine hapsetmek

ID : 107
ISLEM : a1 hücresine hapsetmek
MAKRO KODU : Application.Sheets("Sayfa Adı").ScrollArea = "A1"

a1 hücresine rakam yazmak mecburi yoksa diğer hücrelere geçiş yasak

ID : 108
ISLEM : a1 hücresine rakam yazmak mecburi yoksa diğer hücrelere geçiş yasak
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not IsNumeric(Range("A1")) Or Range("A1") = "" Then Range("A1").ClearContents Range("A1").Select MsgBox "Sie müssen Zelle A1 numerisch füllen !" End If End Sub

a1 hücresine x yazınca yanıp sönme efekti

ID : 109
ISLEM : a1 hücresine x yazınca yanıp sönme efekti
MAKRO KODU : sayfanın kod bölümüne Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address "$A$1" Then Exit Sub If UCase(Range("A1")) = UCase("x") Then Call ersteFarbe Else Call Ende End If End Sub 'thisworkbooka Private Sub Workbook_BeforeClose(Cancel As Boolean) Call Ende End Sub 'modüle Public ET As Variant Sub ersteFarbe() ThisWorkbook.Worksheets("Tabelle1").Range("A1").Interior.ColorIndex = 36 ET = Now + TimeValue("00:00:01") Application.OnTime ET, "zweiteFarbe" End Sub Sub zweiteFarbe() ThisWorkbook.Worksheets("Tabelle1").Range("A1").Interior.ColorIndex = 37 ET = Now + TimeValue("00:00:01") Application.OnTime ET, "ersteFarbe" End Sub Sub Ende() On Error Resume Next Application.OnTime EarliestTime:=ET, Procedure:="ErsteFarbe", Schedule:=False Application.OnTime EarliestTime:=ET, Procedure:="zweiteFarbe", Schedule:=False ET = "" Range("A1").Interior.ColorIndex = xlNone End Sub -

a1 hücresini b1yapiştir c1 gitsin

ID : 110
ISLEM : a1 hücresini b1yapiştir c1 gitsin
MAKRO KODU : Sayın imdatsaral sorularınızı sorarken uygulama örneğinizi aynen verin.Tamam kelimesinden başka anlam ,Kod: MsgBox "Sipariş Tarihini Giriniz..." kodundan başka anlam çıkarıyoruz.Burda rahat olun çekinecek birşey yok.Amacımız,amacınızdır.Öğrenmek,Öğretmek..Bakın.Ben size Þöyle bir örnek hazırladım.. Sipariş Tarihini girerek kullanıcı TextBox1'e:CommandButtona şu kodları yazın.Kod: Private Sub CommandButton1_Click() Range("A1").Select ActiveCell.Formula = TextBox2 End Sub Dosyayı yollıyorum..Herşeyin bir ilk var dimi..

a1 i 1 artırma

ID : 111
ISLEM : a1 i 1 artırma
MAKRO KODU : Sub Count() mycount = Range("a1") + 1 Range("a1") = mycount End Sub Sub Workbook_Open() With Worksheets(1).Range("A1") .Value = .Value + 1 End With End Sub

a1 ile sayfa ekleme ekleyerek

ID : 112
ISLEM : a1 ile sayfa ekleme ekleyerek
MAKRO KODU : Sub FeuilViaLst() Dim Mycell As Range, Mysheet As Worksheet, MyName$ For Each Mycell In Selection 'liste de noms MyName = Mycell.Value If MyName "" Then On Error Resume Next Set Mysheet = Sheets(MyName) On Error GoTo 0 If Mysheet Is Nothing Then Sheets.Add.Name = MyName End If Next Mycell End Sub -

a1 itibaren sayfa isimlerini yaz

ID : 113
ISLEM : a1 itibaren sayfa isimlerini yaz
MAKRO KODU : Sub ListeFeuilles() Application.ScreenUpdating = False Application.DisplayAlerts = False Set ArrFeuil = Sheets("Sayfa1") ArrFeuil.Cells(1, 1).Value = "Tableau des feuilles" For i = 2 To ActiveWorkbook.Sheets.Count ArrFeuil.Cells(i, 1).Value = Sheets(i).Name Next i Application.DisplayAlerts = True Alerte = True Application.ScreenUpdating = True End Sub

a1 sütununda çift kayıt girmek yasak (hücreyeelle girersen siler)

ID : 114
ISLEM : a1 sütununda çift kayıt girmek yasak (hücreyeelle girersen siler)
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) For a = [a65536].End(3).Row To 1 Step -1 If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Rows(a).ClearContents Next End Sub

a1 ve b1 hücresindeki verileri birleştirme

ID : 115
ISLEM : a1 ve b1 hücresindeki verileri birleştirme
MAKRO KODU : Sub birlestir() For a=1 To cells(65536,1).end(xlup).row cells(a,3)=cells(a,1) & " " & cells(a,2) Next End Sub

a1, a3 ten küçükse mesaj verir.

ID : 116
ISLEM : a1, a3 ten küçükse mesaj verir.
MAKRO KODU : Private Sub Worksheet_Calculate() If Range("A1").Value -

a1,b1,c1,d1 e yazı yaz kolonları seç ve sil (bekletmeli silme)

ID : 117
ISLEM : a1,b1,c1,d1 e yazı yaz kolonları seç ve sil (bekletmeli silme)
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next For Each TmpRng In Target TmpVal = TmpRng.Validation.Type If TmpVal > 0 Then If Application.CutCopyMode = 1 Then MsgBox "You cannot paste into validated cells." Application.CutCopyMode = False Exit Sub End If End If Next End Sub

a1:a10 , c1:c10 u karşılaştırır girilen rakamlar farklı ise uyarı verir

ID : 118
ISLEM : a1:a10 , c1:c10 u karşılaştırır girilen rakamlar farklı ise uyarı verir
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If [a10].Value [c10].Value Then MsgBox ("Girdiğiniz rakamlar farklı") End Sub -

a1:a10 arasındaki hücreleri rastgele seçer:

ID : 119
ISLEM : a1:a10 arasındaki hücreleri rastgele seçer:
MAKRO KODU : Sub rast() Dim rastgele As Integer ilk: rastgele = Int(Rnd() * 11) If rastgele -

a1:a10 hücreleri arasında 10 dan büyükleri kalın yapar

ID : 120
ISLEM : a1:a10 hücreleri arasında 10 dan büyükleri kalın yapar
MAKRO KODU : Sub buyukler_kalin() Cells(Rows.Count, "A").End(xlUp).Select For Each rgRow In Range("a1:a10").Rows If rgRow.Cells(1).Value > 10 Then rgRow.Font.Bold = True Else rgRow.Font.Bold = False End If Next rgRow End Sub

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