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


sadece yazılı alandan aşağı doğru yazdırma alanı seçilir, tek hücre bile olsa

ID : 1681
ISLEM : sadece yazılı alandan aşağı doğru yazdırma alanı seçilir, tek hücre bile olsa
MAKRO KODU : Sub print_area() Range(ActiveCell, ActiveCell.End(xlDown)).Select ActiveSheet.PageSetup.PrintArea = ActiveCell.CurrentRegion.Address End Sub

sağ fare yasak belli hücrelerde

ID : 1682
ISLEM : sağ fare yasak belli hücrelerde
MAKRO KODU : Sayfanın kod bölümüne Option Explicit Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) '************************************************** '* pir * '* 07.10.2005 * '************************************************** Dim Bereich As Range Dim Z Set Bereich = Range("B3:C20") If Intersect(Target, Bereich) Is Nothing Then Exit Sub ' Abbruch, wenn Aktion nicht im Zielbereich If Target.Interior.ColorIndex = 3 Then Target.Interior.ColorIndex = xlNone Else Target.Interior.ColorIndex = 3 End If Cancel = True End Sub

sağ fareye kolay menü

ID : 1683
ISLEM : sağ fareye kolay menü
MAKRO KODU : Sub Kontextmenü_Tabellenreiter_ergaenzen() With CommandBars("Ply").Controls.Add .FaceId = 14 .Caption = "Russis neuer Eintrag" .OnAction = "MeinMakro" End With End Sub Veya Sub Kontextmenü_ergänzen() Dim Mb As CommandBarControl Set Mb = Application.CommandBars("Cell").Controls.Add With Mb .Caption = "Mein Menüeintrag" .FaceId = 49 .OnAction = "Mein_Makro" .BeginGroup = True End With End Sub Sub Mein_Makro() MsgBox ("asdasd") End Sub Her 2 Menüyü de silme Sub Kontextmenü_Tabellenreiter_zuruecksetzen() CommandBars("Ply").Reset End Sub Sub Kontextmenü_zurücksetzen() Application.CommandBars("Cell").Reset End Sub

sağ fareye menü

ID : 1684
ISLEM : sağ fareye menü
MAKRO KODU : Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Excel.Range, Cancel As Boolean) Set pir = Application.ShortcutMenus(xlWorksheetCell).MenuItems("ToolBar") With pir .OnAction = "makro" End With End Sub Sub makro() Selection.PasteSpecial Paste:=xlValues End Sub

sağ fareye menüsüne ekleme

ID : 1685
ISLEM : sağ fareye menüsüne ekleme
MAKRO KODU : Sub CreationMenuContext() With Application.CommandBars("Cell").Controls.Add(msoControlButton) .Caption = "Avez-vous un chat?" .BeginGroup = True .OnAction = "Question" End With End Sub Sub Question() MsgBox ("Oui !") End Sub Sub delMenuContext() Application.CommandBars("Cell").Reset End Sub

sağ klik yapinca 3 tane ok çikiyor bunu silemiyorum

ID : 1686
ISLEM : sağ klik yapinca 3 tane ok çikiyor bunu silemiyorum
MAKRO KODU : Sub PanZehir() CommandBars("Cell").Reset End Sub

sağ ok yön tuşu ile textbox atlama

ID : 1687
ISLEM : sağ ok yön tuşu ile textbox atlama
MAKRO KODU : Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 39 Then Me.TextBox2.SetFocus End Sub

sağ üstbilgiye tarih ekleme

ID : 1688
ISLEM : sağ üstbilgiye tarih ekleme
MAKRO KODU : Sub HeaderDate() ActiveSheet.PageSetup.RightHeader = Format(Date, "m/d/yy") End Sub

sağdan kelime alma

ID : 1689
ISLEM : sağdan kelime alma
MAKRO KODU : Ayırdığınız Kelimeyi Silmek istiyorsanız..Yani "Ahmet Eve Geldi Yemek değil"Kelimesinden "değil"kelimesini çıkarıp silmek istorsanız. Kod: Sub ayır() For i = 1 To Cells(65536, 1).End(xlUp).Row a = Split(Cells(i, 1), " ") For j = 0 To UBound(a) - 1 Cells(i, 4) = Cells(i, 4) Next j Cells(i, 3) = a(UBound(a)) Range("c1").Select Selection.ClearContents Next i End Sub Kodları iyi incelerseniz C1'yazılan yer Kod: Cells(i, 3) = a(UBound(a))

sağdan ve soldan ilk boşluklu harf ve harf gruplarını bulma

ID : 1690
ISLEM : sağdan ve soldan ilk boşluklu harf ve harf gruplarını bulma
MAKRO KODU : ‘thisworkbook a yazın ve A1 hücresinde “=pir(A1) veya =pir2(A1) yazın Function pir(Mahmut) For I = 0 To Len(Mahmut) - 1 Verkehrt = Verkehrt & Mid(Mahmut, _ Len(Mahmut) - I, 1) Next I pir = Right(Mahmut, InStr(1, _ Verkehrt, " ", 0)) End Function Function pir2(Bayram) For I = 0 To Len(Bayram) - 1 Verkehrt = Verkehrt & Mid(Bayram, _ Len(Bayram) - I, 1) Next I pir2 = Left(Bayram, InStr(1, _ Verkehrt, " ", 0)) End Function

satır ekleme 32 adet

ID : 1691
ISLEM : satır ekleme 32 adet
MAKRO KODU : Sub strekle() Set s1 = Sheets("Sayfa2") For i = 1 To 12100 s1.Cells(i, 1).Activate s1.Rows(i + 1 & ":" & i + 32).Select Selection.Insert Shift:=xlDown i = i + 32 Next i End Sub

satır gizleme 6 şar satır atlayarak

ID : 1692
ISLEM : satır gizleme 6 şar satır atlayarak
MAKRO KODU : Sub gizle() Dim pir As Integer For pir = 11 To 306 Step 6 Rows(pir).EntireRow.Hidden = Not Rows(pir).EntireRow.Hidden Next pir End Sub

satır gizleme ikinci tıklamada çözülür

ID : 1693
ISLEM : satır gizleme ikinci tıklamada çözülür
MAKRO KODU : Sub blenden() Dim Loi As Integer For Loi = 11 To 306 Step 6 Rows(Loi).EntireRow.Hidden = Not Rows(Loi).EntireRow.Hidden Next Loi End Sub

satır seçme

ID : 1694
ISLEM : satır seçme
MAKRO KODU : Sub MehrereZeilenMarkieren() Range("1:1,3:3,5:5,9:9,11:11").Select End Sub

satır sıralama son satıra kadar

ID : 1695
ISLEM : satır sıralama son satıra kadar
MAKRO KODU : Sub sonsatırakadarsırala() sonsatir = Range("a1").End(xlDown).Row Range(Cells(1, 1), Cells(sonsatir, 2)).Select Selection.Sort _ Key1:=Worksheets("Sheet1").Columns("A"), _ Header:=xlGuess End Sub

satır sıralama tüm sütuna kadar

ID : 1696
ISLEM : satır sıralama tüm sütuna kadar
MAKRO KODU : Sub Tumsutuna_Kadar_Sırala() Columns("A:b").Select Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End Sub

satır sıralama yandaki satırla birlikte

ID : 1697
ISLEM : satır sıralama yandaki satırla birlikte
MAKRO KODU : Sub Makro1() Columns("A:A").Select Range("A1:B4").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Range("B1").Select End Sub

satır sıralama yandaki satırla birlikte 2

ID : 1698
ISLEM : satır sıralama yandaki satırla birlikte 2
MAKRO KODU : Sub Makro1() Columns("A:A").Select Range("A1:B4").Sort Key1:=Range("A1") End Sub

satır sütun başlaıklarını gizle-göster

ID : 1699
ISLEM : satır sütun başlaıklarını gizle-göster
MAKRO KODU : Sub MsqEntetLigCol() 'masque les en-têtes de ligne et colonne ActiveWindow.DisplayHeadings = False End Sub Sub EntetLigCol() 'affiche les en-têtes de ligne et colonne ActiveWindow.DisplayHeadings = True End Sub

satır sütun gizleme 1

ID : 1700
ISLEM : satır sütun gizleme 1
MAKRO KODU : Boş olan Satırları Gizle Sub satirgizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value "" Then Rows(i).Hidden = False Else Sheets("Sayfa1").Rows(i).Hidden = True End If Next i End Sub A Sütunundaki Boş Satırları Gizler Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim i As Integer For i = 1 To 300 '1 satır ile 300. satır arası If IsEmpty(Cells(i, 1)) Then '1. Satır 1. Sütun yani A1 hücresi Rows(i).Hidden = True End If Next i Application.ScreenUpdating = True End Sub C Sütunundaki Boş Satırları Gizler Sub bidahabossatgizle() For i = 6 To 160 If Range("c" & i) = "" Then _ Range("c" & i).EntireRow.Hidden = True Next Boş olan Sütunlar Gizle Sub satirgizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value "" Then Rows(i).Hidden = False Else Sheets("Sayfa1").Rows(i).Hidden = True End If Next i End Sub Toplamları Sıfıra eşit olan satırları gizler Sub sıfırgizle() For Each rngRow In ActiveSheet.UsedRange.Rows If Application.Sum(rngRow) = 0 Then rngRow.EntireRow.Hidden = True End If Next rngRow End Sub -

satır sütun gizleme 2

ID : 1701
ISLEM : satır sütun gizleme 2
MAKRO KODU : Sub HideRowsandColumns() Dim LastRow As Object Dim LastColumn As Object Set LastRow = Range(Range("A65536"), Range("A65536").End(xlUp).Offset(1, 0)) Set LastColumn = Range(Range("IV1"), Range("IV1").End(xlToLeft).Offset(0, 1)) LastRow.EntireRow.Hidden = True LastColumn.EntireColumn.Hidden = True End Sub

satır ve sütun genişliği

ID : 1702
ISLEM : satır ve sütun genişliği
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range Set rng = Columns("C:C") If Not (Intersect(Target, rng) Is Nothing) Then rng.ColumnWidth = 30 Else rng.ColumnWidth = 10.71 End If End Sub

satır ve sütun genişliğini siz belirleyin

ID : 1703
ISLEM : satır ve sütun genişliğini siz belirleyin
MAKRO KODU : Sub zeilenhoehe() Dim hoehe As Single, aktuell As Single, text As String, antwort As String aktuell = Selection.RowHeight / 29.5 text = "Aktuelle Zeilenhöhe: " & Format(aktuell, "###0.00 cm") & Chr(13) & "Geben Sie die gewünschte Zeilenhöhe für die aktuelle Zeile oder Markierung in cm ein:" antwort = InputBox(text, "Neue Zeilenhöhe festlegen", Format(aktuell, "###0.00")) If antwort "" Then hoehe = CSng(antwort) Selection.RowHeight = hoehe * 29.5 End If End Sub Sub spaltenbreite() Dim breite As Single, aktuell As Single, text As String, antwort As String aktuell = (Selection.ColumnWidth + 0.71) / 5.1425 text = "Aktuelle Spaltenbreite: " & Format(aktuell, "###0.00 cm") & Chr(13) & "Geben Sie die gewünschte Spaltenbreite für die aktuelle Spalte oder Markierung in cm ein:" antwort = InputBox(text, "Neue Spaltenbreite festlegen", Format(aktuell, "###0.00")) If antwort "" Then breite = CSng(antwort) Selection.ColumnWidth = -0.71 + 5.1425 * breite End If End Sub -

satır ve sütunla ilgili bir makro

ID : 1704
ISLEM : satır ve sütunla ilgili bir makro
MAKRO KODU : Sub Test() MsgBox FilteredRowsCount(ActiveSheet) & " data was found." MsgBox FilteredRowsCount2(ActiveSheet) & " data was found." End Sub -------------------------------------------------------------------------------- Function FilteredRowsCount(ByVal Sh As Worksheet) Dim Target As Range Dim c As Range Dim i As Long 'If the Filter is not used If Sh.FilterMode = False Then FilteredRowsCount = 0 Exit Function End If Set Target = Sh.AutoFilter.Range For Each c In Target.SpecialCells(xlCellTypeVisible).Areas i = i + c.Rows.Count Next FilteredRowsCount = i - 1 '-1 stands for remove header row End Function -------------------------------------------------------------------------------- Function FilteredRowsCount2(ByVal Sh As Worksheet) Dim Target As Range 'If the Filter is not used If Sh.FilterMode = False Then FilteredRowsCount2 = 0 Exit Function End If Set Target = Sh.AutoFilter.Range FilteredRowsCount2 = _ Target.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 End Function

satır ve sütunlar cm olarak ayarlayın

ID : 1705
ISLEM : satır ve sütunlar cm olarak ayarlayın
MAKRO KODU : Sub satir() Dim yukseklik As Single, mevcut As Single, text As String, cevap As String 'mevcut satır yüksekliğini bul mevcut = Selection.RowHeight / 29.5 'mesaj içriğini hazırla text = "Mevcut satır yüksekliği: " & Format(mevcut, "###0.00 cm") & Chr(13) & "Yeni satır yüksekliğini girin (cm):" 'InputBox göster cevap = InputBox(text, "Yeni satır yüksekliği belirle", Format(mevcut, "###0.00")) 'cevaba göre yeni satır yüksekliği değiştir If cevap "" Then yukseklik = CSng(cevap) Selection.RowHeight = yukseklik * 29.5 End If End Sub Sub sutun() Dim genislik As Single, mevcut As Single, text As String, cevap As String 'mevcut sütun genişliğini bul mevcut = (Selection.ColumnWidth + 0.71) / 5.1425 'mesaj içriğini hazırla text = "Mevcut satır genişliği: " & Format(mevcut, "###0.00 cm") & Chr(13) & "Yeni sütun genişliğini girin:" 'InputBox göster cevap = InputBox(text, "Yeni satır genişliğini girin (cm)", Format(mevcut, "###0.00")) 'cevaba göre yeni sütun genişliğini değiştir If cevap "" Then genislik = CSng(cevap) Selection.ColumnWidth = -0.71 + 5.1425 * genislik End If End Sub -

satır ve sütunları renklendirme

ID : 1706
ISLEM : satır ve sütunları renklendirme
MAKRO KODU : Option Explicit '///////////////////////////////////////////////////// '// Amended 14th Feb 2003 - suggestion by Juan Pablo G. '// International versons may NOT recognise TRUE '// Suggestion use =1 which evaluates to TRUE, '// in fact any number that 0 '//////////////////////////////////////////////////// Const iInternational As Integer = Not (0) Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim iColor As Integer '// Amended routine found on this Web site '// Note: Don't use IF you have Conditional '// formating that you want to keep! '// On error resume in case '// user selects a range of cells On Error Resume Next iColor = Target.Interior.ColorIndex '// Leave On Error ON for Row offset errors If iColor -

satır veya sütundan aritmetik sıralama

ID : 1707
ISLEM : satır veya sütundan aritmetik sıralama
MAKRO KODU : Sub CommandButton1_Click() Dim hucre As Range Dim i As Integer BASADON: Set hucre = Application.InputBox("hücre girin", Type:=8) If (hucre.Row = 1 And hucre.Column = 1) Or (hucre.Row = 1 And hucre.Column = 2) Then cevap = MsgBox("Adres Kaynak ile aynı olmamalı" & vbCrLf & "Değiştirmek İstiyormusunuz?", vbYesNo) If cevap = 6 Then GoTo BASADON Else Exit Sub End If End If If MsgBox("Kolona yazacaksanız EVET" & vbCrLf & "Satıra yazacaksanız HAYIR", vbYesNo) = 6 Then For i = 0 To [B1] - [A1] Cells(hucre.Row + i, hucre.Column) = [A1] + i Next i Else For i = 0 To [B1] - [A1] Cells(hucre.Row, hucre.Column + i) = [A1] + i Next i End If hucre.Select End Sub

satır yüksekliğini ayarlatma

ID : 1708
ISLEM : satır yüksekliğini ayarlatma
MAKRO KODU : Sub ZeilenHoehe() Dim rCM rCM = InputBox("Bitte die gewünschte Zeilenhöhe in cm angeben:") If rCM = "" Then Exit Sub Selection.RowHeight = rCM / 0.035 End Sub

satır, sütun isimleri hücreler dahil herşeyi seçer

ID : 1709
ISLEM : satır, sütun isimleri hücreler dahil herşeyi seçer
MAKRO KODU : Sub SelectEntireSheet() Cells.Select End Sub

satırda ilk boş olan hücreye gider

ID : 1710
ISLEM : satırda ilk boş olan hücreye gider
MAKRO KODU : Sub Finde() Selection.SpecialCells(xlBlanks).Areas(1).Cells(1).Select End Sub

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