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


hücrelerde yuvarlama formülü 2

ID : 1111
ISLEM : hücrelerde yuvarlama formülü 2
MAKRO KODU : Range("A1").Formula = Round(("A1 HÜCRESİNDEKİ FORMÜL TIRNAKLAR OLMADAN") / 50000) * 50000

hücrelerde yuvarlama formülü 3

ID : 1112
ISLEM : hücrelerde yuvarlama formülü 3
MAKRO KODU : [A1] = "=ROUND(" & [A1].Value & "/50000,0)*50000"

hücrelerdeki formüllerin değere dönüşmesi 1

ID : 1113
ISLEM : hücrelerdeki formüllerin değere dönüşmesi 1
MAKRO KODU : Sub metnecevır() Col = 1 DerLig = Cells(65536, Col).End(xlUp).Row For i = 1 To DerLig Cells(i, Col).Formula = "'" & Cells(i, Col) Cells(i, Col).Formula = "" & Cells(i, Col) Next i End Sub

hücrelerdeki formüllerin değere dönüşmesi 2

ID : 1114
ISLEM : hücrelerdeki formüllerin değere dönüşmesi 2
MAKRO KODU : Sub formullerideğeryap() For Each fCell In Selection fCell.Value = fCell.Value Next fCell End Sub

hücrelerdeki verileri birleştirme

ID : 1115
ISLEM : hücrelerdeki 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

hücrelerden biri veya birkaçı boş olunca yazdırmayı iptal etme

ID : 1116
ISLEM : hücrelerden biri veya birkaçı boş olunca yazdırmayı iptal etme
MAKRO KODU : sayfaların kod bölümlerine Option Explicit 'Thisworkbook a Option Explicit Private Sub Workbook_BeforePrint(Cancel As Boolean) If Worksheets("Tabelle1").Range("A1").Value = "" Or _ Worksheets("Tabelle1").Range("B3").Value = "" Or _ Worksheets("Tabelle1").Range("D5").Value = "" Or _ Worksheets("Tabelle1").Range("D7").Value = "" Then MsgBox ("Im Tabellenblatt ''Tabelle1'' sind nicht alle ''Pficht''-Zellen gefüllt !") Cancel = True End If End Sub 'Modüle Option Explicit Sub Makro1() Range("A1,B3,D5,D7").Select Range("D7").Activate End Sub

hücrelerden hangisi dolu ise(a2:e2) onu diğer hücreye yaz (a5)

ID : 1117
ISLEM : hücrelerden hangisi dolu ise(a2:e2) onu diğer hücreye yaz (a5)
MAKRO KODU : Sub doluhucre_yaz() Dim ran Sheets("Sayfa1").Activate ran = range("A2:E2").Select For Each ran In Selection If ran > 0 Then range("A5").Value = ran.Value End If Next End Sub

hücrelere 100 yazdırma diğer sütuna 2 satır ekleyerek atama

ID : 1118
ISLEM : hücrelere 100 yazdırma diğer sütuna 2 satır ekleyerek atama
MAKRO KODU : Sub RempliUnion() Worksheets("Feuil1").Activate Set MaPlage = Application.Union(Range("A1:D10"), Range("F1:H12")) MaPlage.Value = 100 End Sub

hücrelere veri girişi yapildiktan sonra

ID : 1119
ISLEM : hücrelere veri girişi yapildiktan sonra
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(1, -1).Select If Target.Column = 3 Then Target.Offset(1, -2).Select If Target.Column = 4 Then Target.Offset(1, -3).Select If Target.Column = 5 Then Target.Offset(1, -4).Select End Sub

hücreleri boş geçmemek , boş geçecek olursam uyari versin

ID : 1120
ISLEM : hücreleri boş geçmemek , boş geçecek olursam uyari versin
MAKRO KODU : change olayı eğer değer girilmedi ise oluşmayacağı için kullanmak gereksizdir. bunun yerine module 'e Kod: Public col As Integer Public row As Integer worksheet in selection change ine Kod: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B1:B8")) Is Nothing Then Exit Sub If row 0 Then If Cells(row, col) = "" And Target.row row Then MsgBox ("boş geçemezsiniz") Cells(row, col).Select Exit Sub End If End If If Target.row row Then row = Target.row col = Target.Column End If End Sub -

hücreleri doldurmadan yazdırmaz

ID : 1121
ISLEM : hücreleri doldurmadan yazdırmaz
MAKRO KODU : Private Sub Workbook_BeforePrint(Cancel As Boolean) If Worksheets("Tabelle1").Range("A1").Value = "" Or _ Worksheets("Tabelle1").Range("B3").Value = "" Or _ Worksheets("Tabelle1").Range("D5").Value = "" Or _ Worksheets("Tabelle1").Range("D7").Value = "" Then MsgBox ("Im Tabellenblatt ''Tabelle1'' sind nicht alle ''Pficht''-Zellen gefüllt !") Cancel = True End If End Sub

hücreleri image nesnesi olarak kopyalama

ID : 1122
ISLEM : hücreleri image nesnesi olarak kopyalama
MAKRO KODU : Sub Copy_Sel_Image() Range("B2:C4").Copy Range("B6").Select ActiveSheet.Pictures.Paste Application.CutCopyMode = False End Sub

hücreleri resim olarak kopyalamak

ID : 1123
ISLEM : hücreleri resim olarak kopyalamak
MAKRO KODU : Option Explicit Private Sub SaveRngAsJPG(Rng As Range, FileName As String) Dim Cht As Chart, bScreen As Boolean, Shp As Shape bScreen = Application.ScreenUpdating Application.ScreenUpdating = False Set Cht = Workbooks.Add(xlChart).Charts(1) Cht.ChartArea.Clear Rng.CopyPicture xlScreen, xlPicture Cht.Paste With Cht.Shapes(1) .Left = 0 .Top = 0 .Width = Cht.ChartArea.Width .Height = Cht.ChartArea.Height End With Cht.Export FileName, "JPEG", False Cht.Parent.Close False Application.ScreenUpdating = bScreen End Sub Sub TestIt2() Dim Rng As Range, Fn As String Set Rng = Range("A1:H20") Fn = "C:\ExcelSayfam.jpg" SaveRngAsJPG Rng, Fn End Sub

hücreleri seç 2 çeşit madde imi koysun silsin (sırayla 3 tıklama)

ID : 1124
ISLEM : hücreleri seç 2 çeşit madde imi koysun silsin (sırayla 3 tıklama)
MAKRO KODU : Option Explicit Sub AddBullets() Dim Bullet As String Dim Dash As String Dim Cel As Range Dim Str As String Dim i As Long Bullet = "• " Dash = " - " 'select which cells to perform an action on For Each Cel In Selection Str = Cel.Value 'If there is already a bullet there then put a dash in its place If Left(Str, Len(Bullet)) = Bullet Then Str = Right(Str, Len(Str) - 2) Cel.Value = Dash & Str Else 'If there is already a dash there then trim back to normal text If Left(Str, Len(Dash)) = Dash Then Str = Trim(Cel.Value) i = Len(Str) - 1 If i >= 0 Then Cel.Value = Trim(Right(Str, i)) End If Else 'Otherwise add the bullet Cel.Value = Bullet & Str End If End If 'Go to the next cell in the selection and do the same thing Next Cel End Sub

hücrelerin açıklamasını otomatik daralt, rengini değiştir

ID : 1125
ISLEM : hücrelerin açıklamasını otomatik daralt, rengini değiştir
MAKRO KODU : Sub FormatCommentaire() Dim wks As Worksheet, MyCmt As Comment For Each wks In Worksheets For Each MyCmt In wks.Comments MyCmt.Shape.OLEFormat.Object.AutoSize = True With MyCmt.Shape.OLEFormat.Object.Font .Name = "Verdana" .Size = 10 .ColorIndex = 9 .Bold = True End With MyCmt.Shape.OLEFormat.Object.ShapeRange.Fill.ForeColor.SchemeColor = 35 Next MyCmt Next wks End Sub

hücrelerin başindaki ( ' ) tek tirnak sembolünü makro ile nasil kaldirabilirim.

ID : 1126
ISLEM : hücrelerin başindaki ( ' ) tek tirnak sembolünü makro ile nasil kaldirabilirim.
MAKRO KODU : Önce G1 hücresine 1 yazın sonra aşağıdaki makroyu çalıştırın. Bu makro dolu hücreleri 1 ile çarpar ve ' işareti ortadan kalkar. visual basic kodu: Sub Makro1() Range("G1").Select Selection.Copy Selection.SpecialCells(xlCellTypeConstants, 23).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A1").Select End Sub

hücrenin adını siler yani tanımlanan adını siler

ID : 1127
ISLEM : hücrenin adını siler yani tanımlanan adını siler
MAKRO KODU : Sub DeleteRangeNames() Dim rName As Name For Each rName In ActiveWorkbook.Names rName.Delete Next rName End Sub

hücrenin ayrıntılı bilgisi (adresi)

ID : 1128
ISLEM : hücrenin ayrıntılı bilgisi (adresi)
MAKRO KODU : Sub hucre_adresi() Worksheets(1).Select With ActiveCell MsgBox .Address MsgBox .Address(False) MsgBox .Address(, False) MsgBox .Address(False, False) MsgBox .Row & " .satır" MsgBox .Column & " .sütun" MsgBox "Satır Numarası: " & .Row & _ " - Sütun Numarası:" & .Column End With End Sub

hücrenin bulunduğu satır ve sütunu sıra ile mesajla bildirme

ID : 1129
ISLEM : hücrenin bulunduğu satır ve sütunu sıra ile mesajla bildirme
MAKRO KODU : Sub ColLigne() Colonne = Left$(ActiveCell.Address(0, 0), (ActiveCell.Column -

hücrenin çıktısını alma

ID : 1130
ISLEM : hücrenin çıktısını alma
MAKRO KODU : Sub PrintRpt2() Range("H1:A2").PrintOut End Sub

hücrenin değerlerine göre hücreler renklerle dolar

ID : 1131
ISLEM : hücrenin değerlerine göre hücreler renklerle dolar
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target Case " ": Target.Interior.ColorIndex = 15 ' gri Case "A": Target.Interior.ColorIndex = 3 ' kırmızı Case "B": Target.Interior.ColorIndex = 3 Case "A&B": Target.Interior.ColorIndex = 3 Case "-": Target.Interior.ColorIndex = 4 ' yeşil Case Else: Target.Interior.ColorIndex = xlNone End Select End Sub

hücrenin içeriği değişince mesaj verir

ID : 1132
ISLEM : hücrenin içeriği değişince mesaj verir
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column > 0 And Not Target = "" Then MsgBox "içerik değişti" End If End Sub

hücrenin içi kırmızı ,yazılar ise beyaz renkte olsun.ve italık ve bold olsun

ID : 1133
ISLEM : hücrenin içi kırmızı ,yazılar ise beyaz renkte olsun.ve italık ve bold olsun
MAKRO KODU : Dim eski Private Sub Worksheet_SelectionChange(ByVal Target As Range) If eski Empty Then Range(eski).Interior.ColorIndex = 6 Range(eski).Font.ColorIndex = 3 Range(eski).Font.Bold = False Range(eski).Font.Italic = False End If If Target.Column = 1 And Target.Row -

hücrenin zemin renginin sayısal kodu

ID : 1134
ISLEM : hücrenin zemin renginin sayısal kodu
MAKRO KODU : Sub renk() yazirenkkodu = Range("A1").Font.ColorIndex hucrerenkkodu = Range("A1").Interior.ColorIndex End Sub

hücresi belli aktif kolonu seçer

ID : 1135
ISLEM : hücresi belli aktif kolonu seçer
MAKRO KODU : Sub sec() Range("A2").EntireColumn.Select End Sub

hücresi belli aktif satırı seçer

ID : 1136
ISLEM : hücresi belli aktif satırı seçer
MAKRO KODU : Sub satsec() Range("A2").EntireRow.Select Do While ActiveCell.Value "" Loop End Sub -

hücresi belli aktif satırı seçer

ID : 1137
ISLEM : hücresi belli aktif satırı seçer
MAKRO KODU : Sub satsec() ActiveCell.EntireRow.Select End Sub

hücreye açıklama ekle (mesaj kutusu ile)

ID : 1138
ISLEM : hücreye açıklama ekle (mesaj kutusu ile)
MAKRO KODU : Sub InsertionComment() Dim MyCmt As String Dim LaCell As Range Set LaCell = Application.InputBox("Cliquez sur une cellule", Default:=ActiveCell.Address, Type:=8) MyCmt = InputBox("Inscrivez votre commentaire") On Error Resume Next With LaCell .AddComment With .Comment .Visible = True .Text Text:=MyCmt End With End With End Sub

hücreye ad ver, o hücreye yazı yaz, sayfa ismi o olsun

ID : 1139
ISLEM : hücreye ad ver, o hücreye yazı yaz, sayfa ismi o olsun
MAKRO KODU : Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range) If Target.Address = Sh.Range("pir").Address Then Sh.Name = szRenameSheet(Sh, Target) End If End Sub Private Function szRenameSheet(ByVal Sh As Worksheet, ByVal Target As Excel.Range) As String Dim szName As String If Not IsNull(Target) Then szName = CStr(Target.Value) With Application.WorksheetFunction szName = .Substitute(szName, ":", "") szName = .Substitute(szName, "/", "") szName = .Substitute(szName, "\", "") szName = .Substitute(szName, "?", "") szName = .Substitute(szName, "*", "") szName = .Substitute(szName, "[", "") szName = .Substitute(szName, "]", "") End With szRenameSheet = Left$(szName, 31) End If End Function

hücreye check atma

ID : 1140
ISLEM : hücreye check atma
MAKRO KODU : Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True 'Get out of edit mode If LCase(Target.Font.Name) "wingdings 2" Then Exit Sub If Len(Target.Value) > 1 Then Exit Sub If Trim(Target.Value) = "" Then Target.Value = "P" Else Target.Value = "" End If End Sub Not: hücrenin yazı fontu wingdings 2 olmalı. -

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