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


a1-a20 arasına veri girersen mesaj verir

ID : 151
ISLEM : a1-a20 arasına veri girersen mesaj verir
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim Schnittpunkt As Range Set Schnittpunkt = Application.Intersect(Target, Me.Range("A1:A20")) If Schnittpunkt Is Nothing Then Exit Sub Else MsgBox "A1-A20 arasına veri girildi" End If End Sub

a1-a5 arasının ilk harflerini büyük harfe çevirir

ID : 152
ISLEM : a1-a5 arasının ilk harflerini büyük harfe çevirir
MAKRO KODU : Sub ilkharfler_buyuk() For i = 1 To 5 Range("A" & i).Select t = ActiveCell s = Len(t) u = UCase(Left(t, 1)) & Right(t, s - 1) Range("A" & i) = u Next i End Sub

a1'den a3000 e kadar olan hücrelerde eğer herhangi bir veri varsa kırmızı yapar ve satırı tamamen sayfa 3 'e gönder

ID : 153
ISLEM : a1'den a3000 e kadar olan hücrelerde eğer herhangi bir veri varsa kırmızı yapar ve satırı tamamen sayfa 3 'e gönder
MAKRO KODU : Sub DENE_1() Range("1:3000").Interior.ColorIndex = xlNone For x = 1 To 3000 If Cells(x, 1).Value Empty Then Rows(x).Interior.ColorIndex = 3 End If Next x End Sub Sub DENE_2() For x = 1 To 3000 If Cells(x, 1).Value Empty Then Rows(x).Cut Sheets("Sayfa3").Select son = [a65536].End(3).Row + 1 Cells(son, 1).Select ActiveSheet.Paste Sheets("Sayfa1").Select End If Next x End Sub Sub DENE_3() For x = 1 To 3000 yeniden: If Cells(x, 1).Value Empty Then Rows(x).Cut Sheets("Sayfa3").Select son = [a65536].End(3).Row + 1 Cells(son, 1).Select ActiveSheet.Paste Sheets("Sayfa1").Select Rows(x).Delete GoTo yeniden End If Next x End Sub -

a1'e tarih girmeye zorlamak vba ile

ID : 154
ISLEM : a1'e tarih girmeye zorlamak vba ile
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target = Range("A1") Then Date_Validation End Sub ' Input the following code in standard module Sub Date_Validation() Dim dteDate As Date Dim strDate As String With Range("A1") ' Memo original date dteDate = CDate(.Text) ' Create date string strDate = Format(dteDate, "m\/d\/yy") With .Validation ' Delete old settings .Delete ' Set new data validation .Add _ Type:=xlValidateDate, _ AlertStyle:=xlValidAlertStop, _ Operator:=xlGreaterEqual, _ Formula1:=strDate .IgnoreBlank = False .InCellDropdown = True .InputTitle = "" .ErrorTitle = "Invalid Date Entry" .InputMessage = "" .ErrorMessage = _ "Date is older than the previous date (" & _ dteDate & ")." .ShowInput = True .ShowError = True End With End With End Sub

a2 deki tarihi gün ay yıl olarak b2,c2,d2 ye alır

ID : 155
ISLEM : a2 deki tarihi gün ay yıl olarak b2,c2,d2 ye alır
MAKRO KODU : Sub datum_splitten() z = 2 Do While Cells(z, 1) "" Cells(z, 2).NumberFormat = "@" Cells(z, 2) = Left(Cells(z, 1), 2) Cells(z, 3).NumberFormat = "@" Cells(z, 3) = Mid(Cells(z, 1), 4, 2) Cells(z, 4).NumberFormat = "@" Cells(z, 4) = Right(Cells(z, 1), 2) z = z + 1 Loop End Sub -

a2 hücresiyle birbiri üzerine ekleme

ID : 156
ISLEM : a2 hücresiyle birbiri üzerine ekleme
MAKRO KODU : Sub NomOnglet() Dim Name As String Name = Range("A2") Application.ScreenUpdating = False ActiveSheet.Name = (Name) End Sub

a3 seç 2 satır aşağı ve 2 satır yana 5 yaz

ID : 157
ISLEM : a3 seç 2 satır aşağı ve 2 satır yana 5 yaz
MAKRO KODU : Sub satsut() Range("A3").Offset(2, 2) = 5 End Sub

a3 e ne yazarsan b7 de aynısı

ID : 158
ISLEM : a3 e ne yazarsan b7 de aynısı
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim rMonitor As Range Dim rTarget As Range Set rMonitor = Range("A3") Set rTarget = Range("B7") If Not Intersect(Target, rMonitor) Is Nothing Then rMonitor.Copy rTarget End If Set rMonitor = Nothing Set rTarget = Nothing End Sub

a3:f15 hücreleri arasındaki verileri yazdırır

ID : 159
ISLEM : a3:f15 hücreleri arasındaki verileri yazdırır
MAKRO KODU : Sub PrintRpt3() With Worksheets("Sayfa1").PageSetup .CenterHorizontally = True .PrintArea = "$A$3:$F$15" .PrintTitleRows = ("$A$1:$A$2") .Orientation = xlPortrait .FitToPagesWide = 1 .FitToPagesTall = 1 End With Worksheets("Sayfa1").PrintOut End Sub

a5 =2 ise userform açılmasın

ID : 160
ISLEM : a5 =2 ise userform açılmasın
MAKRO KODU : Sub Auto_Open() If Range("a5") 2 Then UserForm1.Show ActiveWorkbook.Save Else ActiveWorkbook.Save ActiveWorkbook.Close End If End Sub -

aç penceresi

ID : 161
ISLEM : aç penceresi
MAKRO KODU : Sub Dialog_28() Application.Dialogs(xlDialogFindFile).Show End Sub

açık olan tüm kitapların kapatılması

ID : 162
ISLEM : açık olan tüm kitapların kapatılması
MAKRO KODU : Workbooks.Close

açıklama ekleme

ID : 163
ISLEM : açıklama ekleme
MAKRO KODU : Sub aciklama_ekler() Dim Açıklama_Ekleme As Comment Dim strText As String strText = Application.InputBox("Eklenecek olan mesajı aşağıya yazınız.", _ "Açıklama_Ekleme", "Açıklama Ekler", , , , 2) If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then ActiveCell.Comment.Delete End If ActiveCell.AddComment Set Açıklama_Ekleme = ActiveCell.Comment With Açıklama_Ekleme .Text Text:=strText With .Shape.TextFrame.Characters.Font .Name = "Arial" .Size = 10 .Bold = False End With End With End Sub

açıklama formunu kapatır

ID : 164
ISLEM : açıklama formunu kapatır
MAKRO KODU : Private Sub CommandButton1_Click() Unload UserForm1 End Sub

açıklama formunun adresi

ID : 165
ISLEM : açıklama formunun adresi
MAKRO KODU : Private Sub CommandButton1_Click() Load UserForm1 UserForm1.Show End Sub

açıklama silme

ID : 166
ISLEM : açıklama silme
MAKRO KODU : Sub aciklama_sil() If Application.ExecuteExcel4Macro("Get.Cell(46)") = True Then ActiveCell.Comment.Delete End If End Sub Sub aciklama_sil() If Not ActiveCell.Comment Is Nothing Then ActiveCell.Comment.Delete End If End Sub

açıklamadaki yazı genişliğini otomatik sığdırma

ID : 167
ISLEM : açıklamadaki yazı genişliğini otomatik sığdırma
MAKRO KODU : Sub auto_comment() Dim commentrange As Range Application.DisplayCommentIndicator = xlCommentAndIndicator For Each commentrange In ActiveSheet.Cells.SpecialCells(1) commentrange.Comment.Shape.Select True Selection.AutoSize = True 'Selection.ShapeRange.Width = 150 'Selection.ShapeRange.Height = 100 Next Application.DisplayCommentIndicator = xlCommentIndicatorOnly End Sub

açıklamanın yazı puntosu ve kalınlığı

ID : 168
ISLEM : açıklamanın yazı puntosu ve kalınlığı
MAKRO KODU : Sub Kommentar_Font() Dim Cell As Range For Each Cell In Cells.SpecialCells(xlCellTypeComments) With Cell.Comment.Shape.TextFrame.Characters.Font .Size = 10 .Bold = True End With Next End Sub

açıklamaya resim eklemek

ID : 169
ISLEM : açıklamaya resim eklemek
MAKRO KODU : Option Explicit Const ImgFileFormat = "Image Files (*.bmp;*.gif;*.tif;*.jpg;*.jpeg)," & _ "*bmp;*gif;*.tif;*.jpg;*.jpeg" Sub AddPicturesToComments() Dim HasCom Dim Pict As String Dim Ans As Integer Set HasCom = ActiveCell.Comment If Not HasCom Is Nothing Then ActiveCell.Comment.Delete Set HasCom = Nothing GetPict: Pict = Application.GetOpenFilename(ImgFileFormat) 'Note you can load in, almost any file format If Pict = "False" Then End Ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?") If Ans = vbNo Then GoTo GetPict With ActiveCell .AddComment .Comment.Visible = False .Comment.Shape.Fill.Transparency = 0# .Comment.Shape.Fill.UserPicture Pict End With End Sub

açılan kitabın ekranını büyütür

ID : 170
ISLEM : açılan kitabın ekranını büyütür
MAKRO KODU : Sub auto_open() Application.WindowState = xlMaximized ActiveWindow.WindowState = xlMaximized Application.MoveAfterReturn = False With ThisWorkbook.Worksheets("Buch") .Range("J2").Value = Month(Date) .Range("K2").Value = Year(Date) .OnEntry = "Fahrtenbuch" End With End Sub

açılış makrosu (istenilen sayfa)

ID : 171
ISLEM : açılış makrosu (istenilen sayfa)
MAKRO KODU : Private Sub Workbook_Open() ThisWorkbook.Worksheets("Sayfa1").Activate End Sub

açılış makrosu(aktif pencerede mesaj verir.)

ID : 172
ISLEM : açılış makrosu(aktif pencerede mesaj verir.)
MAKRO KODU : Sub Auto_Open() Sheets("Bir").Select ActiveWindow.WindowState = xlMaximized Range("C2").Select ActiveWindow.DisplayWorkbookTabs = False ActiveWindow.WindowState = xlMaximized Application.CommandBars("Full Screen").Visible = False Application.CommandBars("Formatting").Visible = False Application.CommandBars("Standard").Visible = False ActiveCell.Select 'mesaj ver yazdır makrosunu kullanarak ilan Application.Caption = "mahmut_bayram@mynet.com" ActiveWindow.Caption = "0505-778 47 69" End Sub

açılış ta prosedür (makro) çalıştırma

ID : 173
ISLEM : açılış ta prosedür (makro) çalıştırma
MAKRO KODU : Sub Auto_Open() ActiveSheet.OnEntry = "Action" End Sub Sub Auto_Close() ActiveSheet.OnEntry = "" End Sub

açılışta aktif pencerenin minimize olması

ID : 174
ISLEM : açılışta aktif pencerenin minimize olması
MAKRO KODU : Option Explicit Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized UsfIntro.Show End Sub 'eski haline gelmesi Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWindow.WindowState = xlNormal End Sub

açılışta ayrı menü olarak araç düğmelerinden bir kaçını getirme

ID : 175
ISLEM : açılışta ayrı menü olarak araç düğmelerinden bir kaçını getirme
MAKRO KODU : Option Explicit Private Sub Workbook_Open() On Error Resume Next With Application.CommandBars("TestCB") .Position = msoBarFloating .Left = 200 .Top = 200 .Visible = True End With End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Application.CommandBars("TestCB").Delete End Sub Private Sub Workbook_Activate() On Error Resume Next Application.CommandBars("TestCB").Visible = True End Sub Private Sub Workbook_Deactivate() On Error Resume Next Application.CommandBars("TestCB").Visible = False End Sub

açılışta b1 tarihi b2 ye kaç kez açıldığını yazar

ID : 176
ISLEM : açılışta b1 tarihi b2 ye kaç kez açıldığını yazar
MAKRO KODU : Private Sub Workbook_Open() Const sAPPLICATION As String = "Excel" Const sSECTION As String = "Invoice" Const sKEY As String = "Invoice_key" Const nDEFAULT As Long = 1& Dim nNumber As Long With ThisWorkbook.Sheets("Sayfa1") With .Range("B1") If IsEmpty(.Value) Then .Value = Date .NumberFormat = "dd mmm yyyy" End If End With With .Range("B2") If IsEmpty(.Value) Then nNumber = GetSetting(sAPPLICATION, sSECTION, sKEY, nDEFAULT) .NumberFormat = "@" .Value = Format(nNumber, "0000") SaveSetting sAPPLICATION, sSECTION, sKEY, nNumber + 1& End If End With End With End Sub

açılışta f8 tuşu ila makro çalıştırma

ID : 177
ISLEM : açılışta f8 tuşu ila makro çalıştırma
MAKRO KODU : Sub Auto_Open() Application.OnKey "%{F8}", "makro" End Sub Sub makro() MsgBox "Merhaba!" MsgBox ActiveCell.Address End Sub

açılışta istediğin makronu çalışsın

ID : 178
ISLEM : açılışta istediğin makronu çalışsın
MAKRO KODU : sub auto_open() call -

açılışta istediğiniz makro otomatik çalıştırma

ID : 179
ISLEM : açılışta istediğiniz makro otomatik çalıştırma
MAKRO KODU : sub auto_open() call calisacakmakroadi ' Çalışmasını istediğiniz makronun adı ... end sub

açılışta istenen sayfa

ID : 180
ISLEM : açılışta istenen sayfa
MAKRO KODU : Sub SayfaHucreSec() Sheets("Sayfa1").Select Selection.Range("A1").Select End Sub

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