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


sayfada, hücrede tek tıklamayla diğer sayfaya gitme

ID : 1861
ISLEM : sayfada, hücrede tek tıklamayla diğer sayfaya gitme
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$18" Then Sheets("Sayfa2").Select End Sub

sayfadaki butonların üzerine gitme

ID : 1862
ISLEM : sayfadaki butonların üzerine gitme
MAKRO KODU : Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long 'pir buton1 c4:e7 genişiliğinde 'buton2 g12:ı15 Sub Cursor1() SetCursorPos 540, 350 'hier die Bildschirmposition anpassen End Sub Sub Cursor2() SetCursorPos 220, 200 End Sub

sayfadaki butonun çalışmasını engeller

ID : 1863
ISLEM : sayfadaki butonun çalışmasını engeller
MAKRO KODU : Sub sheetbuton_disable () Sheets("Sayfa1").Buttons(1).Enabled = False End Sub

sayfadaki commandbuttonun basılmasını önleme

ID : 1864
ISLEM : sayfadaki commandbuttonun basılmasını önleme
MAKRO KODU : Sub SchaltflaecheInaktivieren() Sheets("Sayfa1").Buttons(1).Enabled = False End Sub

sayfadaki dolu alanı seçmek

ID : 1865
ISLEM : sayfadaki dolu alanı seçmek
MAKRO KODU : activesheet.usedrange.select veya, C2 den başlayarak C sütunundaki son dolu hücreye kadar seçim: range("c2:c" & cells(65536, 3).end(xlup).row).select başka bir yazım şekli de; range("c2:c" & range("c65536").end(xlup).row).select

sayfadaki en son dolu hücreden üstteki boş hücreleri siler

ID : 1866
ISLEM : sayfadaki en son dolu hücreden üstteki boş hücreleri siler
MAKRO KODU : Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub SATIR BOŞLUKLARINI DOLDURUR(sayfada) Private Sub CommandButton8_Click() LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub

sayfadaki formüllü hücrelerin formüllerini açıklama olarak ekleme ve silme

ID : 1867
ISLEM : sayfadaki formüllü hücrelerin formüllerini açıklama olarak ekleme ve silme
MAKRO KODU : Sub FormulesEnCommentaires() Dim cell, largeur, hauteur On Error Resume Next For Each cell In ActiveSheet.UsedRange If cell.HasFormula Then cell.AddComment cell.Comment.Text Text:=cell.FormulaLocal With cell.Comment.Shape largeur = .Width hauteur = .Height .TextFrame.AutoSize = True If .Width > 350 Then .Width = 350 .Height = 55 End If End With End If Next End Sub Sub SupprimeCommentaires() For i = ActiveSheet.Comments.Count To 1 Step -1 ActiveSheet.Comments(i).Delete Next i End Sub

sayfadaki kilitli hücrenin kilidini çift tıklama ile açma

ID : 1868
ISLEM : sayfadaki kilitli hücrenin kilidini çift tıklama ile açma
MAKRO KODU : Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ActiveSheet.Unprotect (kubilay) End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Protect password:=kubilay, DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

sayfadaki resmi 180 derece çevirme

ID : 1869
ISLEM : sayfadaki resmi 180 derece çevirme
MAKRO KODU : Sub Rotate() ' select the shape that called this macro ActiveSheet.Shapes(Application.Caller).Select For i = 1 To 180 Selection.ShapeRange.IncrementRotation 4 Application.Calculate ' Just to slow things down a bit Next i Range("A1").Select End Sub

sayfadan adres alıp sütun genişliği ayarlama

ID : 1870
ISLEM : sayfadan adres alıp sütun genişliği ayarlama
MAKRO KODU : Sub Summary_All_Worksheets_With_Formulas() Dim Sh As Worksheet Dim Newsh As Worksheet Dim myCell As Range Dim ColNum As Integer Dim RwNum As Long Dim Basebook As Workbook With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set Basebook = ThisWorkbook Set Newsh = Basebook.Worksheets.Add On Error Resume Next Newsh.Name = "Summary-Sheet" If Err.Number > 0 Then MsgBox "The Summary sheet already exist in this workbook." With Application .DisplayAlerts = False Newsh.Delete .DisplayAlerts = True .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With Exit Sub End If RwNum = 1 'The links to the first sheet will start in row 2 For Each Sh In Basebook.Worksheets If Sh.Name Newsh.Name And Sh.Visible Then ColNum = 1 RwNum = RwNum + 1 Newsh.Cells(RwNum, 1).Value = Sh.Name 'Copy the sheet name in the A column For Each myCell In Sh.Range("A1,D5:E5,Z10") ' -

sayfadan sayfaya geçerken hangi sayfanın aktif olduğunu mesajla bildirir

ID : 1871
ISLEM : sayfadan sayfaya geçerken hangi sayfanın aktif olduğunu mesajla bildirir
MAKRO KODU : Private Sub Workbook_SheetActivate(ByVal Sh As Object) MsgBox Sh.Name End Sub

sayfadan sayfaya geçiş

ID : 1872
ISLEM : sayfadan sayfaya geçiş
MAKRO KODU : CTRL+PAGE UP, CTRL PAGE DOWN OLAYI İPTALİ Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sheets("sayfa1").Select End Sub

sayfadan var ise sayfaadi ni seçip sayfa üzerinde işleme devam edecek yok ise eğer sayfaadi altinda yeni çalişma sayfasi açacak

ID : 1873
ISLEM : sayfadan var ise sayfaadi ni seçip sayfa üzerinde işleme devam edecek yok ise eğer sayfaadi altinda yeni çalişma sayfasi açacak
MAKRO KODU : textbox'larla uğraşmamak için inputbox kullandım, onu değiştirirsiniz. Kodunuzdaki hata elseif için şart döngü içinde kullandığınız için her halikarda sağlanmış oluyor. yani (ElseIf Worksheets(sayfa).Name sayfaadi Then ) bu satır sayfalardan birinde illaki sağlanır. visual basic kodu: -------------------------------------------------------------------------------- Sub sayfalar() sayfaadi = InputBox("sayfaadi") For sayfa = 1 To Worksheets.Count If Worksheets(sayfa).Name = sayfaadi Then Worksheets(sayfaadi).Select Range("a4").Value = 11 Exit Sub End If Next sayfa Worksheets.Add ActiveSheet.Name = sayfaadi ActiveSheet.Select Range("a4").Value = 111 End Sub -

sayfakadi dolu alanı seçmek. satır değişken sütun sabit

ID : 1874
ISLEM : sayfakadi dolu alanı seçmek. satır değişken sütun sabit
MAKRO KODU : activesheet.usedrange.select veya, C2 den başlayarak C sütunundaki son dolu hücreye kadar seçim: range("c2:c" & cells(65536, 3).end(xlup).row).select başka bir yazım şekli de; range("c2:c" & range("c65536").end(xlup).row).select

sayfakadi dolu alani seçmek.

ID : 1875
ISLEM : sayfakadi dolu alani seçmek.
MAKRO KODU : activesheet.usedrange.select veya, C2 den başlayarak C sütunundaki son dolu hücreye kadar seçim: range("c2:c" & cells(65536, 3).end(xlup).row).select başka bir yazım şekli de; range("c2:c" & range("c65536").end(xlup).row).select

sayfalara araç çubuklu ve menülü geçiş

ID : 1876
ISLEM : sayfalara araç çubuklu ve menülü geçiş
MAKRO KODU : Sub sheets_menu() Dim sayfamenu As CommandBar, pir As CommandBarButton, sh As Worksheet On Error Resume Next Application.CommandBars("menuler").Delete On Error GoTo 0 Set sayfamenu = CommandBars.Add(Name:="SayfaMenü", temporary:=True) With sayfamenu .Position = msoBarFloating .Visible = True End With For Each sh In ActiveWorkbook.Sheets Set pir = sayfamenu.Controls.Add(Type:=msoControlButton) With pir .Style = msoButtonCaption .Caption = Left(sh.Name & " ", 16) .Tag = sh.Name .OnAction = "Start" .BeginGroup = True End With Next sh Set pir = sayfamenu.Controls.Add(Type:=msoControlButton) With pir .Style = msoButtonCaption .Caption = "sayfa geçişi" .OnAction = "sheets_menu" .BeginGroup = True End With sayfamenu.Width = 1 End Sub Sub Start() Sheets(Application.CommandBars.ActionControl.Tag).Activate End Sub ‘thisworkbook a Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Application.CommandBars("menuler").Delete On Error GoTo 0 End Sub Private Sub Workbook_Open() Call sheets_menu End Sub

sayfalara isteğe bağli veri kaydetmek

ID : 1877
ISLEM : sayfalara isteğe bağli veri kaydetmek
MAKRO KODU : Levetn beyin yaptığı kodu devam ediyorum. Aşağıdaki şekle getirirseniz liste sayfasında hangi satırda iseniz o satırı veri giriş sayfasına taşır. Kod: Sub kaydet2() a = ActiveCell.Row Sheets("liste").Range("A" & a & ":G" & a).Copy Sheets("veri").Range("B2").PasteSpecial , , , True Application.CutCopyMode = False End Sub

sayfalara otomatik özel alt ve üst bilgi ekleme

ID : 1878
ISLEM : sayfalara otomatik özel alt ve üst bilgi ekleme
MAKRO KODU : Sub InsertHeaderFooter() ' inserts the same header/footer in all worksheets Dim ws As Worksheet Application.ScreenUpdating = False For Each ws In ActiveWorkbook.Worksheets Application.StatusBar = "Changing header/footer in " & ws.Name With ws.PageSetup .LeftHeader = "Company name" .CenterHeader = "Page &P of &N" .RightHeader = "Printed &D &T" .LeftFooter = "Path : " & ActiveWorkbook.Path .CenterFooter = "Workbook name &F" .RightFooter = "Sheet name &A" End With Next ws Set ws = Nothing Application.StatusBar = False End Sub

sayfalara şifre koymak

ID : 1879
ISLEM : sayfalara şifre koymak
MAKRO KODU : Private Sub Worksheet_Activate() Range("A65536").Select If InputBox("şifre Gir?", "şifre") = "123" Then Range("A1").Select Else MsgBox ("şifre Yanlış") Sheets("Sayfa1").Select End If End Sub ' Sayfayı gizleyin. (Biçim/Sayfa/Gizle) sonra açılış makrusuna şu kodu ekleyin Kod: Sub Auto_Open() [b]Sheets("Gizli Sayfa").Visible = True[/b] End Sub Burada mantık şu Makrolar etkinleştirlmesse sayfa görünmez. Etkinleştirldiğinde ise o sayfaya tıklandığında sayfanın kod böülümüne şu kodu ekleyin Kod: Private Sub Worksheet_Activate() Dim sifre Dim durum git: sifre = Application.InputBox("Lütfen Kullanıcı Kodunu Giriniz", _ "Sayın ; " & Application.UserName, "şifre") If sifre = Empty Then Sheets("DiğerSayfa").Select If sifre "şifre" Then durum = MsgBox("Girdiğiniz şifre Yanlıştır " _ & vbNewLine & "Lütfen doru şifre giriniz." _ & vbNewLine & "Tekrar şifre Girmek İstiyormusunuz", vbYesNo, Application.UserName) If durum = vbYes Then GoTo git Else MsgBox "şifre Doğrudur.....!", vbInformation, Application.UserName Exit Sub End If Sheets("DiğerSayfa").Select End Sub -

sayfaları alfabetik sıralama

ID : 1880
ISLEM : sayfaları alfabetik sıralama
MAKRO KODU : Sub SortSheets() Dim SheetNames() As String Dim SheetHidden() As Boolean Dim i As Integer Dim SheetCount As Integer Dim VisibleWins As Integer Dim Item As Object Dim OldActive As Object If ActiveWorkbook Is Nothing Then Exit Sub SheetCount = ActiveWorkbook.Sheets.Count If ActiveWorkbook.ProtectStructure Then MsgBox ActiveWorkbook.Name & " is protected.", _ vbCritical, "Cannot Sort Sheets." Exit Sub End If Application.EnableCancelKey = xlDisabled SheetCount = ActiveWorkbook.Sheets.Count ReDim SheetNames(1 To SheetCount) ReDim SheetHidden(1 To SheetCount) Set OldActive = ActiveSheet For i = 1 To SheetCount SheetNames(i) = ActiveWorkbook.Sheets(i).Name Next i For i = 1 To SheetCount SheetHidden(i) = Not ActiveWorkbook.Sheets(i).Visible If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = True Next i Call BubbleSort(SheetNames) Application.ScreenUpdating = False For i = 1 To SheetCount ActiveWorkbook.Sheets(SheetNames(i)).Move _ before:=ActiveWorkbook.Sheets(i) Next i For i = 1 To SheetCount If SheetHidden(i) Then ActiveWorkbook.Sheets(i).Visible = False Next i OldActive.Activate End Sub Sub BubbleSort(List() As String) Dim First As Integer Dim Last As Integer Dim i As Integer Dim j As Integer Dim Temp As String First = LBound(List) Last = UBound(List) For i = First To Last - 1 For j = i + 1 To Last If UCase(List(i)) > UCase(List(j)) Then Temp = List(j) List(j) = List(i) List(i) = Temp End If Next j Next i End Sub

sayfaları alfabetik sıralama

ID : 1881
ISLEM : sayfaları alfabetik sıralama
MAKRO KODU : Sub sirala() For a = 1 To Sheets.Count For b = a + 1 To Sheets.Count If LCase(Sheets(b).Name) > LCase(Sheets(a).Name) Then GoTo 10 Sheets(b).Move before:=Sheets(a) 10 Next Next End Sub

sayfaları a-z veya z-a ya göre sıralama

ID : 1882
ISLEM : sayfaları a-z veya z-a ya göre sıralama
MAKRO KODU : Sub SortSheetUp() Dim iMax As Integer Dim tb1 As Integer Dim tb2 As Integer Application.ScreenUpdating = False iMax = ThisWorkbook.Sheets.Count For tb1 = 1 To iMax For tb2 = tb1 To iMax If UCase(Sheets(tb2).Name) _ UCase(Sheets(tb1).Name) Then Sheets(tb2).Move before:=Sheets(tb1) End If Next tb2 Next tb1 Application.ScreenUpdating = True End Sub -

sayfaları gösteren userform (form olmadan kod ile)

ID : 1883
ISLEM : sayfaları gösteren userform (form olmadan kod ile)
MAKRO KODU : Option Explicit Dim dlg As DialogSheet ' global variable Sub SheetNavigation() Dim ws As Worksheet Application.ScreenUpdating = False Set dlg = ActiveWorkbook.DialogSheets.Add With dlg.DialogFrame .Left = 0 .Top = 0 .Height = 300 ' dialog height .Width = 300 ' dialog width End With dlg.Buttons(1).Left = 245 ' position of button1 dlg.Buttons(2).Left = 245 ' position of button2 With dlg.ListBoxes.Add(10, 15, 230, 275) ' size of listbox For Each ws In ActiveWorkbook.Worksheets If ws.Visible Then .AddItem ws.Name Next ws .ListIndex = 0 .OnAction = "DisplaySheet" End With dlg.DialogFrame.Text = "Select the worksheet you want to activate" dlg.Visible = False Application.ScreenUpdating = True If dlg.Show Then Worksheets(dlg.ListBoxes(1).List(dlg.ListBoxes(1).ListIndex)).Activate End If Application.DisplayAlerts = False dlg.Delete Application.DisplayAlerts = True Set ws = Nothing Set dlg = Nothing End Sub Private Sub DisplaySheet() Sheets(dlg.ListBoxes(1).List(dlg.ListBoxes(1).ListIndex)).Activate End Sub

sayfaları koruma

ID : 1884
ISLEM : sayfaları koruma
MAKRO KODU : Public Sub ProtectGroupedSheets() Const csPASSWD As String = "drowssap" Dim mySheets As Sheets Dim actSheet As Worksheet Dim wkSht As Worksheet Set actSheet = ActiveSheet Set mySheets = ActiveWindow.SelectedSheets actSheet.Select For Each wkSht In mySheets wkSht.Protect Password:=csPASSWD Next wkSht actSheet.Select mySheets.Select False End Sub

sayfaları köprü olarak ekler

ID : 1885
ISLEM : sayfaları köprü olarak ekler
MAKRO KODU : Sub BlattName() For Blatt = 2 To ActiveWorkbook.Sheets.Count Sheets(1).Cells(Blatt, 1).Select Sheets(Blatt).Name = Sheets(1).Cells(Blatt, 1) ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ Sheets(Blatt).Name & "!A1", TextToDisplay:=ActiveCell.Formula Next Blatt Sheets(1).Select End Sub

sayfaları menü olarak ekleme

ID : 1886
ISLEM : sayfaları menü olarak ekleme
MAKRO KODU : Dim MyControl Sub Auto_Open() MyMenu Range("A1").Select End Sub Sub MyMenu() On Error Resume Next If Not MyControl Is Nothing Then GoTo ResumeSub: Set MyControl = CommandBars.FindControl(Type:=msoControlComboBox, Tag:="MyMenu", Visible:=True) MyControl.Delete On Error GoTo 0 Set MyBar = Application.CommandBars("standard") Set NewCombo = MyBar.Controls.Add(Type:=msoControlComboBox) ResumeSub: With NewCombo .Clear .Text = "Sayfa secin" .Tag = "MyMenu" .Width = 150 .Text = ActiveSheet.Name For i = 1 To Worksheets.Count .AddItem Sheets(i).Name, i Next .DropDownLines = 5 .DropDownWidth = 90 .OnAction = "MyCombo" End With Set NewCombo = Nothing Set MyBar = Nothing Set MyControl = Nothing End Sub ' Sub MyCombo() Set MyControl = CommandBars.FindControl(Type:=msoControlComboBox, Tag:="MyMenu", Visible:=True) Sheets(MyControl.Text).Select Set MyControl = Nothing End Sub ' Sub DelMyMenu() Set MyControl = CommandBars.FindControl(Type:=msoControlComboBox, Tag:="MyMenu", Visible:=True) MyControl.Delete Set MyControl = Nothing End Sub ' Sub Auto_Close() DelMyMenu End Sub

sayfaları seçer aynı hücreleri kalın yapıp, fontunu değiştirir

ID : 1887
ISLEM : sayfaları seçer aynı hücreleri kalın yapıp, fontunu değiştirir
MAKRO KODU : Sub Alle_auswählen() ReDim Matrixvariable(1 To Sheets.Count) For Each Blattname In Sheets Blattzähler = Blattzähler + 1 Matrixvariable(Blattzähler) = Blattname.Name Next For y = 1 To Blattzähler Next Sheets(Matrixvariable()).Select With Selection.Font .Name = "Arial" .Size = 14 End With End Sub

sayfaları sırala a dan z ye

ID : 1888
ISLEM : sayfaları sırala a dan z ye
MAKRO KODU : Sub sayfa_sirala() Dim intI As Integer, intJ As Integer For intI = 1 To Sheets.Count For intJ = 1 To Sheets.Count - 1 If UCase(Sheets(intJ).Name) > UCase(Sheets(intJ + 1).Name) Then Sheets(intJ).Move after:=Sheets(intJ + 1) End If Next Next End Sub

sayfaları tarar ve veri varsa baskı önizleme yapar

ID : 1889
ISLEM : sayfaları tarar ve veri varsa baskı önizleme yapar
MAKRO KODU : Sub MappeDrucken() Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Visible = True Then Sh.PrintPreview End If Next Sh End Sub

sayfaları z-a ya sıralar

ID : 1890
ISLEM : sayfaları z-a ya sıralar
MAKRO KODU : Sub SortSheets() Dim i As Integer, j As Integer For i = 1 To Sheets.Count For j = 1 To Sheets.Count - 1 If UCase$(Sheets(j).Name) -

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