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


sayfa silme & adlandırmayı engelleme

ID : 1801
ISLEM : sayfa silme & adlandırmayı engelleme
MAKRO KODU : Belli menu ve komutları (hem araç çubuğunda hem de sağ klik tuşundaki pop-up menüleri) seçilemez sub menükomutlarıiptal() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(ID:=847) Ctrl.Enabled = False'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(ID:=889) Ctrl.Enabled = False'True menüleri aktif yapar Next Ctrl end sub 'MENÜ KOMUTLARINI AÇAR. sub menükomutlarıaç() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(ID:=847) Ctrl.Enabled = True'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(ID:=889) Ctrl.Enabled = True'True menüleri aktif yapar Next Ctrl end sub

sayfa silme & adlandirmayi engeller

ID : 1802
ISLEM : sayfa silme & adlandirmayi engeller
MAKRO KODU : Belli menu ve komutları (hem araç çubuğunda hem de sağ klik tuşundaki pop-up menüleri) seçilemez sub menükomutlarıiptal() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(ID:=847) Ctrl.Enabled = False'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(ID:=889) Ctrl.Enabled = False'True menüleri aktif yapar Next Ctrl end sub 'MENÜ KOMUTLARINI AÇAR. sub menükomutlarıaç() Dim Ctrl As Office.CommandBarControl For Each Ctrl In Application.CommandBars.FindControls(ID:=847) Ctrl.Enabled = True'True menüleri aktif yapar Next Ctrl For Each Ctrl In Application.CommandBars.FindControls(ID:=889) Ctrl.Enabled = True'True menüleri aktif yapar Next Ctrl end sub

sayfa silme inputbox a yazarak

ID : 1803
ISLEM : sayfa silme inputbox a yazarak
MAKRO KODU : Private Sub CommandButton3_Click() On Error GoTo 10 Application.DisplayAlerts = False sor = InputBox("Silinecek sayfa adını yazınız.") If sor = "" Then Exit Sub mesaj = MsgBox("silmek istediğinizden eminmisiniz", vbYesNo) If mesaj = vbNo Then Exit Sub Sheets("" & sor).Delete Exit Sub 10 MsgBox "sayfa bulunamadı" End Sub

sayfa silme iptal (ing. excel ver.)

ID : 1804
ISLEM : sayfa silme iptal (ing. excel ver.)
MAKRO KODU : Option Explicit Private Sub Worksheet_Activate() With Application .CommandBars("Worksheet Menu Bar").Controls("Edit").Controls("Delete Sheet").Enabled = False .CommandBars("Ply").Controls("Delete").Enabled = False End With End Sub Private Sub Worksheet_Deactivate() With Application .CommandBars("Worksheet Menu Bar").Controls("Edit").Controls("Delete Sheet").Enabled = True .CommandBars("Ply").Controls("Delete").Enabled = True End With End Sub

sayfa silme uyarı mesajı almadan

ID : 1805
ISLEM : sayfa silme uyarı mesajı almadan
MAKRO KODU : Sub sayfasil() Application.DisplayAlerts = False Worksheets("Sayfa1").Delete End Sub

sayfa şifreleme

ID : 1806
ISLEM : sayfa şifreleme
MAKRO KODU : Sub ProtectSheet() Dim Password 'This line of code is optional Password = "1234" ActiveSheet.Protect Password, True, True, True End Sub Sub UnProtectSheet() Password = "1234" ActiveSheet.Unprotect Password End Sub

sayfa şifreleme ve açma

ID : 1807
ISLEM : sayfa şifreleme ve açma
MAKRO KODU : Sub sifrele_ac() ActiveSheet.Unprotect "a" MsgBox "Sayfa şifresi çözüldü" ActiveSheet.Protect MsgBox "Sayfa şifrelendi" End Sub

sayfa üzerinde sağ klik menü

ID : 1808
ISLEM : sayfa üzerinde sağ klik menü
MAKRO KODU : Sub Auto_Open() PopUpMenu End Sub ' Sub PopUpMenu() Dim cb As CommandBar Set cb = Application.CommandBars("Cell") ' Set MenuObject = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True) MenuObject.Caption = "Benim Menüm" MenuObject.BeginGroup = True ' With MenuObject With .Controls.Add(Type:=msoControlButton) .OnAction = "RaiderMacro1" .FaceId = 7 .Caption = "Alt Menüm - 1" End With With .Controls.Add(Type:=msoControlButton) .OnAction = "RaiderMacro2" .FaceId = 17 .Caption = "Alt Menüm - 2" End With With .Controls.Add(Type:=msoControlButton) .OnAction = "RaiderMacro3" .FaceId = 27 .Caption = "Alt Menüm - 3" End With End With ' Set MenuObject2 = MenuObject.Controls.Add(Type:=msoControlPopup, Temporary:=True) MenuObject2.Caption = "Benim 2nci Seviye Menüm - 1" ' With MenuObject2 With .Controls.Add(Type:=msoControlButton) .OnAction = "RaiderMacro4" .FaceId = 37 .Caption = "2nci Seviye(1) Alt Menüm - 1" End With With .Controls.Add(Type:=msoControlButton) .OnAction = "RaiderMacro5" .FaceId = 47 .Caption = "2nci Seviye(1) Alt Menüm - 2" End With End With ' Set MenuObject3 = MenuObject.Controls.Add(Type:=msoControlPopup, Temporary:=True) MenuObject3.Caption = "Benim 2nci Seviye Menüm - 2" ' With MenuObject3 With .Controls.Add(Type:=msoControlButton, ID:=4) .Visible = True End With With .Controls.Add(Type:=msoControlButton, ID:=3) .Visible = True End With With .Controls.Add(Type:=msoControlButton, ID:=1695) .Visible = True End With End With ' Set cb = Nothing Set MenuObject = Nothing Set MenuObject2 = Nothing End Sub ' Sub RaiderMacro1() MsgBox "RaiderMacro1 çalıştırıldı !" & vbCrLf & vbCrLf & "(AltMenü-1)" End Sub ' Sub RaiderMacro2() MsgBox "RaiderMacro2 çalıştırıldı !" & vbCrLf & vbCrLf & "(AltMenü-2)" End Sub ' Sub RaiderMacro3() MsgBox "RaiderMacro3 çalıştırıldı !" & vbCrLf & vbCrLf & "(AltMenü-3)" End Sub ' Sub RaiderMacro4() MsgBox "RaiderMacro4 çalıştırıldı !" & vbCrLf & vbCrLf & "(2nci Seviye AltMenü-1)" End Sub ' Sub RaiderMacro5() MsgBox "RaiderMacro5 çalıştırıldı !" & vbCrLf & vbCrLf & "(2nci Seviye AltMenü-2)" End Sub ' Sub Auto_Close() Application.CommandBars("Cell").Reset End Sub

sayfa1 a sütununda sıralı olmayan isimleri aynı anda sayfa2 a sütununda a-z ye sıralar

ID : 1809
ISLEM : sayfa1 a sütununda sıralı olmayan isimleri aynı anda sayfa2 a sütununda a-z ye sıralar
MAKRO KODU : ’Sayfa2 de mouse sağ click, Kod Görüntüle deyin çıkan ekrana bu kodları yapıştırın. Private Sub Worksheet_Activate() Set s1 = Sheets("Sayfa1") Set s2 = Sheets("Sayfa2") With s2.[A1:A1000] .Value = s1.[A1:A1000].Value .Sort [A1] End With Set s1 = Nothing Set s2 = Nothing End Sub

sayfa1 a1,b1,c1 dolu ve b sütunu gizli,a1 ve c1 i sayfa2 de a1,b1 e kopyala

ID : 1810
ISLEM : sayfa1 a1,b1,c1 dolu ve b sütunu gizli,a1 ve c1 i sayfa2 de a1,b1 e kopyala
MAKRO KODU : Option Explicit Sub sichtbare_kopieren() Range("A1").CurrentRegion _ .SpecialCells(xlCellTypeVisible).Copy _ Worksheets("Tabelle2").Range("A1") End Sub

sayfa1 a1:a100 arasinda dolgu rengi sari olan hücre varsa o satirin a:an araliğini sayfa2 ye nasil kopyalariz

ID : 1811
ISLEM : sayfa1 a1:a100 arasinda dolgu rengi sari olan hücre varsa o satirin a:an araliğini sayfa2 ye nasil kopyalariz
MAKRO KODU : Sub Test2() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim MyRng As Range Dim Nrow As Long Set Sh1 = Sheets("Sheet1") Set Sh2 = Sheets("Sheet2") Sh2.Range("A1:A" & Sh2.Range("A65536").End(xlUp).Row).Clear For Each MyRng In Sh1.Range("A1:A100") If MyRng.Interior.ColorIndex = 6 Then Nrow = Sh2.Range("A65536").End(xlUp).Row + 1 Sh1.Rows(MyRng.Row).Copy Sh2.Range("A" & Nrow).PasteSpecial End If Next Application.CutCopyMode = False Range("A1").Select End Sub

sayfa1 de arar bulur, sayfa2 de listeler

ID : 1812
ISLEM : sayfa1 de arar bulur, sayfa2 de listeler
MAKRO KODU : Sub Arabul_listele() Dim i As Integer Dim j As Integer Dim Sayac As Integer Dim SinananVeri As String Veri = InputBox("Aranan Veriyi Belirtiniz", "ARANAN VERİ", "") SinananVeri = "*" & Veri & "*" Set Say1 = Worksheets("Sayfa1") Set Say2 = Worksheets("Sayfa2") j = 1 For i = 1 To 10 If WorksheetFunction.CountIf(Say2.Cells(i, 1), SinananVeri) > 0 Then Say1.Cells(j, 1) = Say2.Cells(i, 1) Sayac = Sayac + 1 j = j + 1 End If Next i MsgBox Say2.Name & "'de aramış olduğunuz " & Veri & " verisini içeren toplam " & Sayac & " adet hücre değeri bulundu ve " & Say1.Name & "'de listelendi." End Sub

sayfa1 excel açilirken 10 saniye gözüksün.

ID : 1813
ISLEM : sayfa1 excel açilirken 10 saniye gözüksün.
MAKRO KODU : Application.wait metodu ile visual basic kodu: Sub Auto_Open() Sheets("sayfa1").Select Application.Wait Now + TimeValue("00:00:10") Sheets("sayfa2").Select End Sub Application.ontime metodu ile visual basic kodu: Sub Auto_Open() Sheets("sayfa1").Select zaman = Now + TimeValue("00:00:10") Application.OnTime zaman, "sayfasec" End Sub Sub sayfasec() Sheets("sayfa2").Select End Sub

sayfa1 excel açilirken 10 saniye gözüksün...

ID : 1814
ISLEM : sayfa1 excel açilirken 10 saniye gözüksün...
MAKRO KODU : Application.wait metodu ile visual basic kodu: Sub Auto_Open() Sheets("sayfa1").Select Application.Wait Now + TimeValue("00:00:10") Sheets("sayfa2").Select End Sub Application.ontime metodu ile visual basic kodu: Sub Auto_Open() Sheets("sayfa1").Select zaman = Now + TimeValue("00:00:10") Application.OnTime zaman, "sayfasec" End Sub Sub sayfasec() Sheets("sayfa2").Select End Sub

sayfa1 i yazdırma

ID : 1815
ISLEM : sayfa1 i yazdırma
MAKRO KODU : Sub Print() Sheets("Sayfa1").PrintOut End Sub

sayfa1 in tam ekran olması

ID : 1816
ISLEM : sayfa1 in tam ekran olması
MAKRO KODU : Private Sub Workbook_Activate() If ActiveSheet.Name = "Sayfa1" Then Application.DisplayFullScreen = True End Sub Private Sub Workbook_Deactivate() Application.DisplayFullScreen = False End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) If ActiveSheet.Name = "Sayfa1" Then Application.DisplayFullScreen = True End Sub Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) Application.DisplayFullScreen = False End Sub

sayfa1'deki bütün kodları silebilirsiniz

ID : 1817
ISLEM : sayfa1'deki bütün kodları silebilirsiniz
MAKRO KODU : Sub kod_sil() With ThisWorkbook.VBProject.VBComponents("Sayfa1").CodeModule .DeleteLines 1, .CountOfLines End With End Sub

sayfa2 ye geçince b1 hücresini seç ve macro çalıştır:

ID : 1818
ISLEM : sayfa2 ye geçince b1 hücresini seç ve macro çalıştır:
MAKRO KODU : Private Sub Worksheet_Activate() Range("B1").Select MsgBox"Sayfa2 ye Hoş Geldiniz" End Sub

sayfa2 yi çok gizler

ID : 1819
ISLEM : sayfa2 yi çok gizler
MAKRO KODU : Sub Hide_WS2() Worksheets(2).Visible = xlVeryHidden End Sub

sayfa2 yi gizler

ID : 1820
ISLEM : sayfa2 yi gizler
MAKRO KODU : Sub Hide_WS1() Worksheets(2).Visible = Hide End Sub

sayfa2 yi gizler gösterir(sırayla 2 tane tıkla)

ID : 1821
ISLEM : sayfa2 yi gizler gösterir(sırayla 2 tane tıkla)
MAKRO KODU : Sub Toggle_Hidden_Visible() Worksheets(2).Visible = Not Worksheets(2).Visible End Sub

sayfa2 yi göster

ID : 1822
ISLEM : sayfa2 yi göster
MAKRO KODU : Sub UnHide_WS() Worksheets(2).Visible = True End Sub

sayfada a,b,c,d harflerinden birine tıklayınca istenileni yazdırma

ID : 1823
ISLEM : sayfada a,b,c,d harflerinden birine tıklayınca istenileni yazdırma
MAKRO KODU : Thisworkbooka Option Explicit Private Sub Workbook_Deactivate() With Application.AutoCorrect .DeleteReplacement What:="a" .DeleteReplacement What:="b" .DeleteReplacement What:="c" .DeleteReplacement What:="d" End With End Sub Private Sub Workbook_Open() With Application.AutoCorrect .AddReplacement What:="a", Replacement:="Klaus" .AddReplacement What:="b", Replacement:="Marcus" .AddReplacement What:="c", Replacement:="Peter" .AddReplacement What:="d", Replacement:="Berti" End With End Sub

sayfada b5:g22 arasını seçtirmeme

ID : 1824
ISLEM : sayfada b5:g22 arasını seçtirmeme
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.CellDragAndDrop = False If Intersect(Target, Range("B5:G22")) Is Nothing Then Range("A1").Select End If End Sub

sayfada belli hücrelere veri girilince yanındaki satıra tarihini atar

ID : 1825
ISLEM : sayfada belli hücrelere veri girilince yanındaki satıra tarihini atar
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim RaBereich As Range, RaZelle As Range Set RaBereich = Range("B3:B20, D1:D7") ' ActiveSheet.Unprotect Application.EnableEvents = False For Each RaZelle In Range(Target.Address) If Not Intersect(RaZelle, RaBereich) Is Nothing Then RaZelle.Offset(0, 1) = Date Next RaZelle ' ActiveSheet.protect Application.EnableEvents = True Set RaBereich = Nothing End Sub

sayfada boş satırları gizler

ID : 1826
ISLEM : sayfada boş satırları gizler
MAKRO KODU : Sub bossatir_gizle() Rows("1:250").EntireRow.Hidden = False For x = 5 To 250 gizle = 0 For y = 2 To 5 If Cells(x, y) 0 Then gizle = 1 Next y If Cells(x, 6) = "E" Then gizle = 1 If gizle = 0 Then Rows(x & ":" & x).EntireRow.Hidden = True End If Next x Columns("C:J").EntireColumn.AutoFit End Sub -

sayfada boş satırları göster

ID : 1827
ISLEM : sayfada boş satırları göster
MAKRO KODU : Sub satirlari_ac() Rows("1:250").EntireRow.Hidden = False End Sub

sayfada bul ve göster

ID : 1828
ISLEM : sayfada bul ve göster
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; Kod: 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

sayfada buton ismi öğrenme

ID : 1829
ISLEM : sayfada buton ismi öğrenme
MAKRO KODU : Sub buton_text() MsgBox (ActiveSheet.Buttons(Application.Caller).Text) End Sub

sayfada büyük harf 1

ID : 1830
ISLEM : sayfada büyük harf 1
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 3 Or Target.Column = 4 Then kelime = Replace(Target.Value, "i", "İ") kelime = Replace(kelime, "ı", "I") Target.Value = StrConv(kelime, vbUpperCase) End If End Sub

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