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


aktif hücrenin numerik veya yazı olduğunu kontrol etme

ID : 241
ISLEM : aktif hücrenin numerik veya yazı olduğunu kontrol etme
MAKRO KODU : Sub numeric_control() If Not Application.IsNumber(ActiveCell) Then MsgBox "Numerik değil" Else MsgBox "Numerik" End If End Sub Sub text_control() If Not Application.IsText(ActiveCell) Then MsgBox "Yazı değil" Else MsgBox "Yazı" End If End Sub

aktif hücrenin sayfa başına çıkmasını istiyor musunuz?

ID : 242
ISLEM : aktif hücrenin sayfa başına çıkmasını istiyor musunuz?
MAKRO KODU : Sayfanın kod bölümüne Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.Goto Reference:=ActiveCell, Scroll:=True End Sub

aktif hücrenin üstüne 4 satır ekler

ID : 243
ISLEM : aktif hücrenin üstüne 4 satır ekler
MAKRO KODU : Sub dortsatirekle() ActiveCell.Rows("1:4").EntireRow.Select Selection.Insert Shift:=xlDown ActiveCell.Offset(3, 0).Range("A1").Select End Sub

aktif hücrenin yazdırılması

ID : 244
ISLEM : aktif hücrenin yazdırılması
MAKRO KODU : Sub PrintSelectedCells() Dim aCount As Integer, cCount As Integer, rCount As Integer Dim i As Integer, j As Long, aRange As String Dim rHeight() As Single, cWidth() As Single Dim AWB As Workbook, NWB As Workbook If UCase(TypeName(ActiveSheet)) "WORKSHEET" Then Exit Sub aCount = Selection.Areas.Count If aCount = 0 Then Exit Sub ' no cells selected cCount = Selection.Areas(1).Cells.Count If aCount > 1 Then ' multiple areas selected Application.ScreenUpdating = False Application.StatusBar = "Printing " & aCount & " selected areas..." Set AWB = ActiveWorkbook rCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Row cCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Column ReDim rHeight(rCount) ReDim cWidth(cCount) For i = 1 To rCount rHeight(i) = Rows(i).RowHeight Next i For i = 1 To cCount cWidth(i) = Columns(i).ColumnWidth Next i Set NWB = Workbooks.Add ' create a new workbook For i = 1 To rCount ' set row heights Rows(i).RowHeight = rHeight(i) Next i For i = 1 To cCount ' set column widths Columns(i).ColumnWidth = cWidth(i) Next i For i = 1 To aCount AWB.Activate aRange = Selection.Areas(i).Address Range(aRange).Copy ' copying the range NWB.Activate With Range(aRange) ' pastes values and formats .PasteSpecial Paste:=xlValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End With Application.CutCopyMode = False Next i NWB.PrintOut NWB.Close False ' close the temporary workbook without saving Application.StatusBar = False AWB.Activate Set AWB = Nothing Set NWB = Nothing Else If cCount -

aktif hücreye açıklama ekleme ve o açıklamanın yazı tipi ve puntosunu ayarlama

ID : 245
ISLEM : aktif hücreye açıklama ekleme ve o açıklamanın yazı tipi ve puntosunu ayarlama
MAKRO KODU : Sub commenter() Dim Cmt As Comment Set Cmt = ActiveCell.AddComment Cmt.Text "Mahmut BAYRAM" With Cmt.Shape.TextFrame.Characters.Font .Name = "Arial" .Size = 14 End With End Sub

aktif hücreye bugünün tarihini ekler

ID : 246
ISLEM : aktif hücreye bugünün tarihini ekler
MAKRO KODU : Sub FirmDate() Selection.Value = Date End Sub Font listele Sub SchriftLesen() Dim C As CommandBarControl Dim i As Integer Set C = CommandBars.FindControl(ID:=1728) For i = 1 To C.ListCount With Cells(i, 1) .Value = C.List(i) .Font.Name = C.List(i) End With Next i End Sub

aktif hücreye çalışma kitabının ve aktif sayfanın adını yazdırır

ID : 247
ISLEM : aktif hücreye çalışma kitabının ve aktif sayfanın adını yazdırır
MAKRO KODU : Sub KitapveSayfaadi() ActiveCell.Value = ExecuteExcel4Macro("get.document(1)") End Sub

aktif hücreye çift tıkla 1 artırsın

ID : 248
ISLEM : aktif hücreye çift tıkla 1 artırsın
MAKRO KODU : Private Sub Worksheet_BeforeDoubleClick(ByVal Target _ As Range, Cancel As Boolean) Cancel = True 'Get out of edit mode If Target.Row = 1 Then Exit Sub If Target.Column 2 Then Exit Sub 'Require Col B On Error Resume Next Application.EnableEvents = False Target.Value = Target.Value + 1 Application.EnableEvents = True If Err.Number 0 Then MsgBox "Unable to add 1 to value in cell " _ & Target.Address(0, 0) End If End Sub -

aktif hücreye çift tıkla alttoplam eklesin

ID : 249
ISLEM : aktif hücreye çift tıkla alttoplam eklesin
MAKRO KODU : Private Sub Worksheet_BeforeDoubleClick(ByVal _ Target As Range, Cancel As Boolean) 'David McRitchie, misc, 2001-07-02 '-- Find top cell in continguous range Cancel = True 'Get out of edit mode Range(Target.Offset(-1, 0).End(xlUp), Target).Select '-- leave selection of cells showing for visual verification. Target.Formula = "=SUBTOTAL(9," _ & Selection(1).Address(0, 0) & ":" _ & Selection(Selection.Count - 1).Address(0, 0) & ")" 'make the double-clicked cell the active cell for the range Target.Activate End Sub

aktif hücreye çift tıklamayla tarih ekleme

ID : 250
ISLEM : aktif hücreye çift tıklamayla tarih ekleme
MAKRO KODU : Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) ActiveCell = Date End Sub

aktif hücreyi 1 artır

ID : 251
ISLEM : aktif hücreyi 1 artır
MAKRO KODU : Aktif hücre değerini bir artır. Sub addme() i = ActiveCell ActiveCell.Value = (i + 1) End Sub

aktif hücreyi 1 eksilt

ID : 252
ISLEM : aktif hücreyi 1 eksilt
MAKRO KODU : Aktif hücre değerini bir artır. Sub addme() i = ActiveCell ActiveCell.Value = (i -1) End Sub

aktif hücreyi 30 artırma

ID : 253
ISLEM : aktif hücreyi 30 artırma
MAKRO KODU : Sub artir_30() Dim pir pir = ActiveCell + 30 ActiveCell = pir End Sub

aktif hücreyi listbox ve textboxa alma (spinbutton kullanarak)

ID : 254
ISLEM : aktif hücreyi listbox ve textboxa alma (spinbutton kullanarak)
MAKRO KODU : Private Sub SpinButton1_SpinUp() On Error Resume Next ActiveCell.Offset(-1, 0).Select TextBox1 = ActiveCell Call UserForm_Initialize End Sub Private Sub SpinButton1_SpinDown() On Error Resume Next ActiveCell.Offset(1, 0).Select TextBox1 = ActiveCell Call UserForm_Initialize End Sub Private Sub SpinButton2_SpinDown() On Error Resume Next ActiveCell.Offset(0, -1).Select TextBox1 = ActiveCell Call UserForm_Initialize End Sub Private Sub SpinButton2_SpinUp() On Error Resume Next ActiveCell.Offset(0, 1).Select TextBox1 = ActiveCell Call UserForm_Initialize End Sub Private Sub UserForm_Initialize() ListBox1.Clear ListBox1.AddItem (ActiveCell) TextBox1.Text = "" TextBox1 = ActiveCell End Sub

aktif hücreyi seçince yakınlaştırıp uzaklaştırma (c2 hücresi)

ID : 255
ISLEM : aktif hücreyi seçince yakınlaştırıp uzaklaştırma (c2 hücresi)
MAKRO KODU : Sayfanın kod bölümüne Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Row = 2 And Target.Column = 3 Then 'für Zelle C2, ggf. anpassen ActiveWindow.Zoom = 200 Else ActiveWindow.Zoom = 100 End If End Sub

aktif kitabın email penceresi

ID : 256
ISLEM : aktif kitabın email penceresi
MAKRO KODU : Sub EmailWorkbook() Application.Dialogs(xlDialogSendMail).Show End Sub

aktif kolonu seçer

ID : 257
ISLEM : aktif kolonu seçer
MAKRO KODU : Sub aktifkolon() ActiveCell.EntireColumn.Select End Sub

aktif olan çalışma kitabı pencerelerini minimize etme

ID : 258
ISLEM : aktif olan çalışma kitabı pencerelerini minimize etme
MAKRO KODU : Sub Red_Class() Dim i As Integer For i = 1 To Workbooks.Count Workbooks(i).Activate ActiveWindow.WindowState = xlMinimized Next i End Sub

aktif olan hücre renklensin...

ID : 259
ISLEM : aktif olan hücre renklensin...
MAKRO KODU : Private Sub Workbook_BeforePrint(Cancel As Boolean) Cells.Interior.ColorIndex = xlNone End Sub

aktif olan hücrede veri varsa ad tanımlar

ID : 260
ISLEM : aktif olan hücrede veri varsa ad tanımlar
MAKRO KODU : Sub AddName3() Dim rngSelect As String rngSelect = Selection.Address ActiveSheet.Names.Add Name:="MyRange3", RefersTo:="=" & rngSelect End Sub

aktif olan visual basic formunun kapatilmasi

ID : 261
ISLEM : aktif olan visual basic formunun kapatilmasi
MAKRO KODU : Private Sub CommandButton1_Click() Unload UserForm1 End Sub Hüseyin Bey 'de böyle algılamış olacak ki Command1 yerine CommandButton1 yazmış. VB de de aynı kod geçerli olacaktır. Kod: Private Sub Command1_Click() Unload Form1 End Sub Hide ile Unload arasındaki fark bu. O halde başka bir düğme ile formu tekrar aktif yapmak isterseniz Initialize olayını kullanmalısınız. Eğer Hüseyin Bey'in dediği gibi gizlemişseniz o zman Activate olayını kullanmalısınız. O halde özet yapacak olursak. Hide ----> Activate Unload ---> VBA için Initialize , VB için Load

aktif pencerenin başlığına kullanıcı adını atar

ID : 262
ISLEM : aktif pencerenin başlığına kullanıcı adını atar
MAKRO KODU : Sub UserName() ActiveWindow.Caption = ActiveWindow _ .Caption & " " & Application.UserName End Sub

aktif satırda hafta sonlarını işaretler

ID : 263
ISLEM : aktif satırda hafta sonlarını işaretler
MAKRO KODU : Sub haftasonuisaretle() For Each oCell In Range(Cells(1, 4), Cells(1, 14)) If Weekday(oCell.Value) = 7 Or Weekday(oCell.Value) = 1 Then With oCell.Interior .Pattern = xlGray16 .PatternColorIndex = 42 End With End If Next oCell End Sub

aktif satırdan itibaren tek tek alt satırı seçer

ID : 264
ISLEM : aktif satırdan itibaren tek tek alt satırı seçer
MAKRO KODU : Sub selectionrowscount() Dim ZeileAnfang As Integer Dim ZeileEnde As Integer Dim SpalteAnfang As Integer Dim SpalteEnde As Integer SpalteAnfang = Selection.Column SpalteEnde = Selection.Columns.Count ZeileAnfang = Selection.Row ZeileEnde = Selection.Rows.Count ZeileAnfang = ZeileAnfang ZeileEnde = ZeileEnde + ZeileAnfang SpalteEnde = SpalteEnde + SpalteAnfang - 1 Range(Cells(ZeileAnfang, SpalteAnfang), Cells(ZeileEnde, SpalteEnde)).Select End Sub

aktif satırın hepsini seçer

ID : 265
ISLEM : aktif satırın hepsini seçer
MAKRO KODU : Sub ZeilenAuswahl() Selection.EntireRow.Select End Sub

aktif satırın herhangi bir sütununda bir satır bile dolu olsa silmez(satırda boşlukları aldırma)

ID : 266
ISLEM : aktif satırın herhangi bir sütununda bir satır bile dolu olsa silmez(satırda boşlukları aldırma)
MAKRO KODU : Sub DeleteBlankRowsEvenFaster() Set myrange = Range("B4:I31") Set blanks = myrange.SpecialCells(xlCellTypeBlanks) For Each area In blanks.Areas If area.Columns.Count = myrange.Columns.Count Then n = n + 1 If n = 1 Then Set delrange = area.EntireRow Else Set delrange = Union(delrange, area.EntireRow) End If End If Next area delrange.Delete End Sub

aktif satırın herhangi bir sütununda bir satır bile dolu olsa silmez(satırda boşlukları aldırma) 2

ID : 267
ISLEM : aktif satırın herhangi bir sütununda bir satır bile dolu olsa silmez(satırda boşlukları aldırma) 2
MAKRO KODU : Sub DeleteBlankRows() Set myrange = Range("B4:I31") Set blanks = myrange.SpecialCells(xlCellTypeBlanks) For Each area In blanks.Areas If area.Columns.Count = myrange.Columns.Count Then area.EntireRow.Delete End If Next area End Sub

aktif sayfa haricinde tüm sayfaları siler

ID : 268
ISLEM : aktif sayfa haricinde tüm sayfaları siler
MAKRO KODU : Sub DeleteSheets() Application.DisplayAlerts = False For Each Sheet In Worksheets If Sheet.Name ActiveSheet.Name Then Sheet.Delete Next Application.DisplayAlerts = True End If End Sub -

aktif sayfa ismini değiştirme

ID : 269
ISLEM : aktif sayfa ismini değiştirme
MAKRO KODU : Sub ArbeitsblattUmbenennen() Activesheet.Name="Neuer Name" End Sub

aktif sayfa ve hedef hücrelerde saat formatı

ID : 270
ISLEM : aktif sayfa ve hedef hücrelerde saat formatı
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim TimeStr As String On Error GoTo EndMacro If Application.Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub End If If Target.Cells.Count > 1 Then Exit Sub End If If Target.Value = "" Then Exit Sub End If Application.EnableEvents = False With Target If .HasFormula = False Then Select Case Len(.Value) Case 1 ' e.g., 1 = 00:01 AM TimeStr = "00:0" & .Value Case 2 ' e.g., 12 = 00:12 AM TimeStr = "00:" & .Value Case 3 ' e.g., 735 = 7:35 AM TimeStr = Left(.Value, 1) & ":" & _ Right(.Value, 2) Case 4 ' e.g., 1234 = 12:34 TimeStr = Left(.Value, 2) & ":" & _ Right(.Value, 2) Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45 TimeStr = Left(.Value, 1) & ":" & _ Mid(.Value, 2, 2) & ":" & Right(.Value, 2) Case 6 ' e.g., 123456 = 12:34:56 TimeStr = Left(.Value, 2) & ":" & _ Mid(.Value, 3, 2) & ":" & Right(.Value, 2) Case Else Err.Raise 0 End Select .Value = TimeValue(TimeStr) End If End With Application.EnableEvents = True Exit Sub EndMacro: MsgBox "You did not enter a valid time" Application.EnableEvents = True End Sub

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