Makro Kod Listesi

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

ID : 1261
ISLEM : kaç satır seçili olduğunu bulur
MAKRO KODU : Sub Count() mycount = Selection.Rows.Count MsgBox mycount End Sub

ID : 1262
ISLEM : kaç sayfa var hesaplasın
MAKRO KODU : Sub sayfasay() say= Application.Sheets.Count MsgBox (say) End Sub

ID : 1263
ISLEM : kaçıncı hafta olduğunu bulan fonksiyon
MAKRO KODU : Function hafta(tarih As Date) As Integer ek = 7 - Day(DateSerial(Year(tarih), 1, 1) + 7 - Weekday(DateSerial(Year(tarih), 1, 1), vbMonday)) hafta = ((tarih + 7 - Weekday(tarih, vbMonday)) - DateSerial(Year(tarih), 1, 1) + 1 + ek) / 7 End Function

ID : 1264
ISLEM : kaçıncı hafta olduğunu bulan fonksiyon
MAKRO KODU : Dim tarih As Date, hafta As Integer tarih = Date hafta = DatePart("ww", tarih, vbMonday, vbFirstJan1) MsgBox "Bugün: " & Date & " --> Yılın " & hafta & ". Haftası"

ID : 1265
ISLEM : kaçıncı hafta olduğunu bulan fonksiyon kodları
MAKRO KODU : =Kwoche(J20) Function Kwoche(d) Dim t t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1) Kwoche = ((d - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1 End Function

ID : 1266
ISLEM : kaçıncı hafta, hangi gün sorusunun cevabı
MAKRO KODU : Private Sub CommandButton1_Click() MsgBox Weekday(Date, vbMonday) Select Case Weekday(Date, vbMonday) Case 1: gun = "Bugün pazartesi, " Case 2: gun = "Salı" Case 3: gun = "Çarşamba " Case 4, 5: gun = "Hafta içi son günler " Case Is > 5: gun = "Hafta Sonu" Case Else: gun="Böyle bir gün olamaz" End Select MsgBox gun End Sub

ID : 1267
ISLEM : kaçıncı satır kaçıncı sütun
MAKRO KODU : Sub MyPosition() myRow = ActiveCell.Row & ".satır" myCol = ActiveCell.Column & ".sütun" MsgBox myRow & " , " & myCol End Sub

ID : 1268
ISLEM : kaçıncı satır kaçıncı sütuna ne girecen
MAKRO KODU : Sub negircen() sutun = InputBox("Kaçıncı Sütun:") satir = InputBox("Kaçıncı Satır:") yaz = InputBox("yaz:") Range("A1").Select ActiveCell.Offset(satir - 1, sutun - 1).Range("A1").Select ActiveCell.Value = yaz End Sub

ID : 1269
ISLEM : kalın olanları topla
MAKRO KODU : kullanılışı '=kalintop(a1:a10) Function kalintop(rngCells As Range) As Double Application.Volatile Dim cell As Range kalintop = 0 On Error Resume Next For Each cell In rngCells If cell.Font.Bold Then kalintop = kalintop + cell.Value Next cell End Function

ID : 1270
ISLEM : kapalı dosyalardan verileri toplayarak almak
MAKRO KODU : Aşağıdaki kod ile "C:\Temp\" klasöründe kapalı durumda olan tüm çalışma 'kitaplarındaki Sheet1 isimli sayfalarında A1:E10 aralığındaki tüm hücreler 'toplanarak, kodun yazıldığı kitapta yine A1:E10 aralığındaki hücrelere yazılırlar. Const MyPath As String = "C:\Temp\" Const MySh As String = "Sheet1" Dim MyArg As String ' Sub Test() 'Raider Dim MyFile As String Dim i As Long, j As Integer Range("A1:E10").ClearContents MyFile = Dir(MyPath & Application.PathSeparator & "*.xls", vbDirectory) Do While MyFile <> "" If MyFile = ThisWorkbook.Name Then GoTo ResumeSub: MyArg = "'" & MyPath & "[" & MyFile & "]" & MySh & "'!R" For j = 1 To 5 For i = 1 To 10 Cells(i, j) = Cells(i, j) + ExecuteExcel4Macro(MyArg & i & "C" & j) Next Next ResumeSub: MyFile = Dir Loop End Sub

ID : 1271
ISLEM : kapalı kitap ontime
MAKRO KODU : ‘kitabı kapat, vakit geldiğinde açılıp ve gerekli uyarıyı verir Sub dene() Application.OnTime Now + TimeValue("00:00:10"), "deneme" End Sub Sub deneme() MsgBox "oldu" End Sub

ID : 1272
ISLEM : kapalı kitap ontime
MAKRO KODU : Public soru Sub auto_open() soru = MsgBox("Gizlensin mi?", vbYesNo) If soru = vbYes Then Application.Visible = False Call dene End If End Sub Sub dene() Application.OnTime Now + TimeValue("00:00:03"), "deneme2" End Sub Sub deneme2() günler = MsgBox("günü dolanlar var" & vbCrLf & "Excel çalışma kitabı açılsın mı?", vbYesNo) If günler = vbNo Then Call dene Else Application.Visible = True End If End Sub Private Sub Workbook_Activate() If soru = vbYes Then Application.Visible = False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) soru2 = MsgBox("Zamanlanmış görevi olan dosyada kapansın mı?", vbYesNo) If soru2 = vbYes Then Exit Sub Cancel = True End Sub

ID : 1273
ISLEM : kapalı olan sayfanın boş olan bir alttaki satırına kayıt
MAKRO KODU : Sub datagonder() Rows(2).Copy Windows("notdata.xls").Activate son = [a65356].End(3).Row + 1 Rows(son).PasteSpecial Windows("notisleme.xls").Activate End Sub

ID : 1274
ISLEM : kapali durumdaki c:\test.xls dosyasi açilacak ve içine c:\userform1.frm ilave edildikten sonra kaydedilerek kapatilacaktir
MAKRO KODU : Kullanıcıya göndereceğin B.xls dosyasındaki kod; Kod: Sub Test() Myfile = "C:\Test.xls" MyForm = "C:\UserForm1.frm" If Dir(Myfile) <> Empty And Dir(MyForm) <> Empty Then Workbooks.Open Myfile On Error GoTo ErrHandler: Workbooks(Dir(Myfile)).VBProject.VBComponents.Import MyForm Workbooks(Dir(Myfile)).Close SaveChanges:=True MsgBox "İşlem tamam !" Exit Sub Else MsgBox Myfile & " ve " & MyForm & " dosyalarının isimlerini ve doğru" _ & " yerleştirildiğini kontrol edin !" Exit Sub End If ErrHandler: Select Case Err.Number Case 60061 MsgBox "Dosyada " & Dir(MyForm) & " zaten mevcut !" Case Else MsgBox Err.Number & vbCrLf & Err.Description End Select Workbooks(Dir(Myfile)).Close SaveChanges:=False End Sub Yapılan iş; yukarıdaki kodlar çalıştırıldığında kapalı durumdaki C:\Test.xls dosyası açılacak ve içine C:\UserForm1.frm ilave edildikten sonra kaydedilerek kapatılacaktır. Kodlar çalıştırılmadan önce yapılması gereken ise; kullanıcının C:\Test.xls ve C:\UserForm1.frm dosyalarını kendi bilgisayarlarında, kodlarda belirtilen yerlere yerleştirmiş olmasıdır.

ID : 1275
ISLEM : kapanış-çıkış makrosu
MAKRO KODU : Sub auto_close() Sheets("Bir").Select Range("C2").Select End Sub

ID : 1276
ISLEM : kapaniş mesaji
MAKRO KODU : Public Sub CommandButton13_Click() cevap = MsgBox(" PROGRAMI KAPATMAK İSTEDİĞİNİZDEN EMİNMİSİNİZ ? ", vbYesNo, "") If cevap = vbNo Then Exit Sub Unload Me Application.Quit If cevap = vbYes Then auto_close End If End Sub Private Sub CommandButton13_Click() Cevap = MsgBox(" PROGRAMI KAPATMAK İSTEDİĞİNİZDEN EMİNMİSİNİZ ? ", vbYesNo, "") If Cevap = vbNo Then Exit Sub Unload Me kullanici = Application.UserName saat = Format(Now, "hh:mm:ss") tarih = Format(Date, "d mmmm yyyy dddd") sor = MsgBox(" GÖRÜŞMEK ÜZERE " & kullanici & Chr(10) & Chr(10) & _ "………..BÜROSU/ 0212 …………." & Chr(10) & Chr(10) & _ "Tarih : " & tarih & Chr(10) & Chr(10) _ & "Saat : " & saat & Chr(10) & Chr(10) _ & "………. BÜROSU iyi Çalışmalar Diler." & Chr(10) & Chr(10) & _ "Dosyanızın kaydedilmesini istiyor musunuz?", 4, "") If sor = vbYes Then ActiveWorkbook.Save ActiveWorkbook.Close Else Application.DisplayAlerts = False ActiveWorkbook.Close End If End Sub

ID : 1277
ISLEM : karma örnekler
MAKRO KODU : 1- Hücre Seçmek. 1- Range("B2").Select 2- Cells(2,1).Select 3- [B2].Select 2- Hücreye değer atamak. Range("B2").Value=100 'sayısal değer Range("B2").Value="pir" 'Text; tırnak içinde 3- Hücredeki Fontun Büyüklüğünü değiştirmek. Range("B2").Font.Size=20 4- Hücredeki fontun adını değiştirmek. Range("B2").Font.Name="Verdana" 5- Hücredeki fontu Kalın,İtalic ve Altı Çizgili yapmak. Range("B2").Font.Bold = True Range("B2").Font.Italic = True Range("B2").Font.Underline = xlUnderlineStyleSingle ve yahut Range("B2").Select Selection.Font.Bold = True Selection.Font.Italic = True Selection.Font.Underline = xlUnderlineStyleSingle 6- Hücrenin dolgu rengini değiştirmek. Range("B2").Interior.ColorIndex = 6 'Sarı renk 7- Hücrenin Fontunun rengini değiştirmek. Range("B2").Font.ColorIndex = 3 'Kırmızı renk 8- Hücreye Formül yazdırmak. Range("B2").Formula="=A1+A2"'A1 ve A2 hücresini toplar,B2 ye yazdırır. 9- Aktif olan hücrenin etrafındaki hücreyi seçmek ActiveCell.Offset(1, 0).Select 'Aktif hücrenin altıdakini seçer. ActiveCell.Offset(-1, 0).Select 'Aktif hücrenin üstündekini seçer. ActiveCell.Offset(0, 1).Select 'Aktif hücrenin sağındakini seçer. ActiveCell.Offset(0, -1).Select 'Aktif hücrenin solundakini seçer. 10- Aktif olan hücrenin belirtilen kadar uzağındaki hücreyi seçmek. ActiveCell.Offset(0, 5).Select 'Aktif hücrenin sağındaki 5. hücreyi seçer. 11- Aktif hücreden belirtilen uzaklıktaki hücreye değer atamak. ActiveCell.Offset(1,1).Value = "Muhammed" 'Aktif hücrenin altında ve sağındaki hücreye Muhammed yazdırır. 12- Aktif hücrenin üzerindeki iki hücrenin değerleri toplanır ve sonuç aktif olan hücreye yazılır. Sub toplama() t1 = ActiveCell.Offset(-1, 0).Value t2 = ActiveCell.Offset(-2, 0).Value ActiveCell.Value = t1 + t2 End Sub 13- Seçili hücrelerdeki biçimleri siler. Selection.ClearFormats 14- Seçili hücreleri aşağı öteler. Range("A1:A5").Select 'A1 ile A5 arasındaki hücreler seçilir. Selection.Insert Shift:=xlDown 'Seçimi aşağı kaydırır. Burada sadece seçili olan 5 adet hücre aşağı kaydırılır. 15- Seçili hücrelere ait hüm satırı ötelemek. Range("A1:A5").Select Selection.EntireRow.Insert '14. koddan farklı olarak seçili olan hücrelere ait 1 ila 5 arasındaki tüm satırlar 5 satır aşağı ötelenir. 16- Seçili hücrelere ait tüm sütunu ötelemek. Range("D6:E7).Select selection.EntireColumn.Insert 17- Açık olan Excel Çalışma Kitabının belirtilen sayfasındaki istenen hücreye değer atar. Workbooks("Kitap1.xls").Worksheets("Sayfa1").Range("A1").Value = 3 18- Yapılan seçimlerde boş olmayan hücre sayısını verir. Sub hucresayisi() Dim kontur As Integer kontur = Application.CountA(Selection) MsgBox "Seçimdeki dolu hücrelerin sayısı:" & kontur End Sub 19- 18. maddedeki kodlamada 'CountA' da bulunan 'A' kaldırılırsa seçimde sadece kaç hücrede sayı (rakam) varsa onların adedini verir. Application.Count(Selection) 20- Seçili hücrelerin sayısını verir. Selection.Count 21- Seçimin satır sayısını verir. Selection.Rows.Count 22- Seçimin sütun sayısını verir. Selection.Columns.Count 24- Seçili hücrenin altında veriler varsa onları seçer. İlk boş hücreden sonra ilk değer olan hücreyi seçer. Range(ActiveCell,ActiveCell.End(xlDown)).Select 25- 24. de üstteki hücreler için aynı ilemi yapar. Range(ActiveCell,ActiveCell.End(xlUp)).Select 26- 24. de sağdaki hücreler için aynı işlemi yapar. Range(ActiveCell,ActiveCell.End(xlToRight)).Select 27- 24. de soldaki hücreler için aynı işlemi yapar. Range(ActiveCell,ActiveCell.End(xlToLeft)).Select 28- Aktif hücrenin etrafındaki dolu hücreleri seçer. ActiveCell.CurrentRegion.Select 29- Seçimin etrafındaki dolu hücreleri seçer. Selection.CurrentRegion.Select ActiveCell.EntireColumn.Select 31- Seçili hücrelerin bulundukları sütunları tamamen seçer. Selection.EntireColumn.Select 30- Aktif hücrenin bulunduğu satırı tamamını seçer. ActiveCell.EntireRow.Select 31- Seçili hücrelerin bulundukları satırları tamamen seçer. Selection.EntireRow.Select 32- Çalışma sayfasında bulunan bütün hücreleri seçer. Cells.Select 33- Dolu hücrelerden sonraki ilk boş hücreyi seçer. (Sütunlar için.) Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select '(0,1) olduğu zaman satırlar için olur. Loop Eğer A1 Hücresi 1 ise Mesaj kutusu çalışsın ve excelpazarı yazsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Then If Target.Value = "1" Then MsgBox "ExcelPazarı" End If End Sub Örneğin 4. sütunda İşlem yapılırsa macro otomatik çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 4 Then MsgBox "Aşkın'dan Selamlar" End Sub Örneğin 4. Satırta İşlem yapılırsa macro otomatik çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Row = 4 Then MsgBox "Aşkından Selamlar" End Sub Eğer A1 Hücresi sıfırdan büyükse macro çalışsın. Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Range("A1") >= 1 Then MsgBox "Aşkından Selamlar" End Sub Eğer A1 Hücresinin Değeri A3 Hücresindeki değerden düşükse macro çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Or Target.Address = "$A$3" Then If Range("A1").Value < Range("A3").Value Then Macro1 End If End If End Sub YAZILAN AÇIKLAMAYI GÖSTERİR (selam) Sub Macro1() MsgBox "Selam" End Sub Eğer A1 Hücresinde işlem yapılırsa A2 Hücresine değiştirilme tarihi ve saatini yazar Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target = Cells(1, 1) Then Cells(2, 1) = Now End Sub 'alternatif ŞİMDİ() or Bugün or Time SATIR SÜTUN GİZLEME İŞLEMLERİ EĞER AKTİF HÜCRE DEĞERİ 1 DEN BÜYÜK İSE AKTİF HÜCRENİN ALTINA BOŞ SATIR EKLER Sub InserLSiRupture() Set x = ActiveCell Do Until IsEmpty(x) If x.Row > 1 Then If x.Offset(-1, 0).Value <> x.Value Then Rows(x.Row).Insert Shift:=xlDown End If End If Set x = x.Offset(1, 0) Loop End Sub Bir önceki işlem yapılan hücreyi seç Sub LastCell() Selection.SpecialCells(xlLastCell).Select End Sub Boş Hücreleri Seç Sub boshucresec() Selection.SpecialCells(xlCellTypeBlanks).Select End Sub Eğer aktif hücreler nümerik (sayı) ise ve 500 den büyükse kalın yap Sub aktiflestir() If IsNumeric(ActiveCell) Then ActiveCell.Font.Bold = ActiveCell.Value >= 500 End If End Sub EĞER C1 HÜCRESİ BOŞSA C4 HÜCRESİNİ BOŞALT BOŞ DEĞİLSE C1 HÜCRESİNDEKİ DEĞERİ YAZI Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$C$4" And Target.Value = "Y" Then Target.Value = Range("C1").Value End If End Sub

ID : 1278
ISLEM : karma örnekler
MAKRO KODU : 1- Hücre Seçmek. 1- Range("B2").Select 2- Cells(2,1).Select 3- [B2].Select 2- Hücreye değer atamak. Range("B2").Value=100 'sayısal değer Range("B2").Value="pir" 'Text; tırnak içinde 3- Hücredeki Fontun Büyüklüğünü değiştirmek. Range("B2").Font.Size=20 4- Hücredeki fontun adını değiştirmek. Range("B2").Font.Name="Verdana" 5- Hücredeki fontu Kalın,İtalic ve Altı Çizgili yapmak. Range("B2").Font.Bold = True Range("B2").Font.Italic = True Range("B2").Font.Underline = xlUnderlineStyleSingle ve yahut Range("B2").Select Selection.Font.Bold = True Selection.Font.Italic = True Selection.Font.Underline = xlUnderlineStyleSingle 6- Hücrenin dolgu rengini değiştirmek. Range("B2").Interior.ColorIndex = 6 'Sarı renk 7- Hücrenin Fontunun rengini değiştirmek. Range("B2").Font.ColorIndex = 3 'Kırmızı renk 8- Hücreye Formül yazdırmak. Range("B2").Formula="=A1+A2"'A1 ve A2 hücresini toplar,B2 ye yazdırır. 9- Aktif olan hücrenin etrafındaki hücreyi seçmek ActiveCell.Offset(1, 0).Select 'Aktif hücrenin altıdakini seçer. ActiveCell.Offset(-1, 0).Select 'Aktif hücrenin üstündekini seçer. ActiveCell.Offset(0, 1).Select 'Aktif hücrenin sağındakini seçer. ActiveCell.Offset(0, -1).Select 'Aktif hücrenin solundakini seçer. 10- Aktif olan hücrenin belirtilen kadar uzağındaki hücreyi seçmek. ActiveCell.Offset(0, 5).Select 'Aktif hücrenin sağındaki 5. hücreyi seçer. 11- Aktif hücreden belirtilen uzaklıktaki hücreye değer atamak. ActiveCell.Offset(1,1).Value = "Muhammed" 'Aktif hücrenin altında ve sağındaki hücreye Muhammed yazdırır. 12- Aktif hücrenin üzerindeki iki hücrenin değerleri toplanır ve sonuç aktif olan hücreye yazılır. Sub toplama() t1 = ActiveCell.Offset(-1, 0).Value t2 = ActiveCell.Offset(-2, 0).Value ActiveCell.Value = t1 + t2 End Sub 13- Seçili hücrelerdeki biçimleri siler. Selection.ClearFormats 14- Seçili hücreleri aşağı öteler. Range("A1:A5").Select 'A1 ile A5 arasındaki hücreler seçilir. Selection.Insert Shift:=xlDown 'Seçimi aşağı kaydırır. Burada sadece seçili olan 5 adet hücre aşağı kaydırılır. 15- Seçili hücrelere ait hüm satırı ötelemek. Range("A1:A5").Select Selection.EntireRow.Insert '14. koddan farklı olarak seçili olan hücrelere ait 1 ila 5 arasındaki tüm satırlar 5 satır aşağı ötelenir. 16- Seçili hücrelere ait tüm sütunu ötelemek. Range("D6:E7).Select selection.EntireColumn.Insert 17- Açık olan Excel Çalışma Kitabının belirtilen sayfasındaki istenen hücreye değer atar. Workbooks("Kitap1.xls").Worksheets("Sayfa1").Range("A1").Value = 3 18- Yapılan seçimlerde boş olmayan hücre sayısını verir. Sub hucresayisi() Dim kontur As Integer kontur = Application.CountA(Selection) MsgBox "Seçimdeki dolu hücrelerin sayısı:" & kontur End Sub 19- 18. maddedeki kodlamada 'CountA' da bulunan 'A' kaldırılırsa seçimde sadece kaç hücrede sayı (rakam) varsa onların adedini verir. Application.Count(Selection) 20- Seçili hücrelerin sayısını verir. Selection.Count 21- Seçimin satır sayısını verir. Selection.Rows.Count 22- Seçimin sütun sayısını verir. Selection.Columns.Count 24- Seçili hücrenin altında veriler varsa onları seçer. İlk boş hücreden sonra ilk değer olan hücreyi seçer. Range(ActiveCell,ActiveCell.End(xlDown)).Select 25- 24. de üstteki hücreler için aynı ilemi yapar. Range(ActiveCell,ActiveCell.End(xlUp)).Select 26- 24. de sağdaki hücreler için aynı işlemi yapar. Range(ActiveCell,ActiveCell.End(xlToRight)).Select 27- 24. de soldaki hücreler için aynı işlemi yapar. Range(ActiveCell,ActiveCell.End(xlToLeft)).Select 28- Aktif hücrenin etrafındaki dolu hücreleri seçer. ActiveCell.CurrentRegion.Select 29- Seçimin etrafındaki dolu hücreleri seçer. Selection.CurrentRegion.Select ActiveCell.EntireColumn.Select 31- Seçili hücrelerin bulundukları sütunları tamamen seçer. Selection.EntireColumn.Select 30- Aktif hücrenin bulunduğu satırı tamamını seçer. ActiveCell.EntireRow.Select 31- Seçili hücrelerin bulundukları satırları tamamen seçer. Selection.EntireRow.Select 32- Çalışma sayfasında bulunan bütün hücreleri seçer. Cells.Select 33- Dolu hücrelerden sonraki ilk boş hücreyi seçer. (Sütunlar için.) Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select '(0,1) olduğu zaman satırlar için olur. Loop Eğer A1 Hücresi 1 ise Mesaj kutusu çalışsın ve excelpazarı yazsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Then If Target.Value = "1" Then MsgBox "ExcelPazarı" End If End Sub Örneğin 4. sütunda İşlem yapılırsa macro otomatik çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 4 Then MsgBox "Aşkın'dan Selamlar" End Sub Örneğin 4. Satırta İşlem yapılırsa macro otomatik çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Row = 4 Then MsgBox "Aşkından Selamlar" End Sub Eğer A1 Hücresi sıfırdan büyükse macro çalışsın. Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Range("A1") >= 1 Then MsgBox "Aşkından Selamlar" End Sub Eğer A1 Hücresinin Değeri A3 Hücresindeki değerden düşükse macro çalışsın Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Or Target.Address = "$A$3" Then If Range("A1").Value < Range("A3").Value Then Macro1 End If End If End Sub YAZILAN AÇIKLAMAYI GÖSTERİR (selam) Sub Macro1() MsgBox "Selam" End Sub Eğer A1 Hücresinde işlem yapılırsa A2 Hücresine değiştirilme tarihi ve saatini yazar Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target = Cells(1, 1) Then Cells(2, 1) = Now End Sub 'alternatif ŞİMDİ() or Bugün or Time SATIR SÜTUN GİZLEME İŞLEMLERİ EĞER AKTİF HÜCRE DEĞERİ 1 DEN BÜYÜK İSE AKTİF HÜCRENİN ALTINA BOŞ SATIR EKLER Sub InserLSiRupture() Set x = ActiveCell Do Until IsEmpty(x) If x.Row > 1 Then If x.Offset(-1, 0).Value <> x.Value Then Rows(x.Row).Insert Shift:=xlDown End If End If Set x = x.Offset(1, 0) Loop End Sub Bir önceki işlem yapılan hücreyi seç Sub LastCell() Selection.SpecialCells(xlLastCell).Select End Sub Boş Hücreleri Seç Sub boshucresec() Selection.SpecialCells(xlCellTypeBlanks).Select End Sub Eğer aktif hücreler nümerik (sayı) ise ve 500 den büyükse kalın yap Sub aktiflestir() If IsNumeric(ActiveCell) Then ActiveCell.Font.Bold = ActiveCell.Value >= 500 End If End Sub EĞER C1 HÜCRESİ BOŞSA C4 HÜCRESİNİ BOŞALT BOŞ DEĞİLSE C1 HÜCRESİNDEKİ DEĞERİ YAZI Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$C$4" And Target.Value = "Y" Then Target.Value = Range("C1").Value End If End Sub

ID : 1279
ISLEM : karşılama (açılış makrosu)
MAKRO KODU : Private Sub Workbook_Open() Dim Utilis As String Dim DateJour As Date 'Récupération du nom de l'utilisateur Utilis = Application.UserName 'Récupération de la date du jour DateJour = Date Msgbox "Selamün Aleyküm " & Utilis & Chr(10) & _ "Nous sommes le " & DateJour End Sub

ID : 1280
ISLEM : karşılaştırma; sayfa1 sayfa2 a,b,c sütunları
MAKRO KODU : Sub Karsilastir1() Dim Sh1 As Worksheet, Sh2 As Worksheet Dim Bul As Range, Soyad, i Dim ilkAdres Set Sh1 = Worksheets("Sayfa1") Set Sh2 = Worksheets("Sayfa2") For i = 2 To Sh2.Cells(65536, "C").End(xlUp).Row Soyad = Sh2.Cells(i, 3) Set Bul = Sh1.Range("C:C").Find(Soyad, LookAt:=xlWhole) If Not Bul Is Nothing Then ilkAdres = Bul.Address Do If Sh2.Cells(i, 2) = Bul.Offset(, -1) Then Bul.Offset(, 1) = "Bulundu" End If Set Bul = Sh1.Range("C:C").FindNext(Bul) Loop Until ilkAdres = Bul.Address End If Next End Sub

ID : 1281
ISLEM : kaydederek çıkış
MAKRO KODU : Sub kaydet_cik() ThisWorkbook.Close Saved = True End Sub

ID : 1282
ISLEM : kaydederken a1 e tarih ve saatini yazar
MAKRO KODU : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Range("A1") = Now 'Select any cell you want End Sub

ID : 1283
ISLEM : kaydederken mesaj verdirme
MAKRO KODU : Private Sub Workbook_BeforeSave _ (ByVal SaveAsUI As Boolean, Cancel As Boolean) pir = _ MsgBox(" Gerçekten kadetmek istiyor musunuz?", _ vbYesNo) If pir = vbNo Then Cancel = True End Sub

ID : 1284
ISLEM : kaydedince a1 e tarihli kaydeder sol alt bilgi olarak ta ekler
MAKRO KODU : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Range("A1").Value = "Stand: " & Format(Date, "DD.MM.YYYY") Worksheets("Tabelle1").PageSetup.LeftFooter = "Stand: " & Format(Date, "DD.MM.YYYY") End Sub

ID : 1285
ISLEM : kaydet,temizle ve tamamen kapat
MAKRO KODU : Sub Makro1() Range("A1:C20").ClearContents ActiveWorkbook.Save Application.Quit End Sub

ID : 1286
ISLEM : kaydetmeden çıkış
MAKRO KODU : Sub Ohne_Speichern_schliessen() ThisWorkbook.Close Saved = True 'oder ThisWorkbook.Close False End Sub

ID : 1287
ISLEM : kaydetmeden çıkış
MAKRO KODU : Sub close() ThisWorkbook.Close Saved = True End Sub

ID : 1288
ISLEM : kaydetmeden kapatma
MAKRO KODU : Sub DateiSchließen() ActiveWorkbooks.Close SaveChanges:=False End Sub

ID : 1289
ISLEM : kaydetmeden önce şifre isteme
MAKRO KODU : Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) a = InputBox("Kaydetmek için şifrenizini girin") If a <> 1234 Then Cancel = True End If End Sub

ID : 1290
ISLEM : kayit engelenebilir mi?
MAKRO KODU : Thisworkbook'a aşağıdaki kodları ekleyin Private Sub Workbook_BeforePrint(Cancel As Boolean) If Sheets("Sayfa1").Range("M56") = "" Then MsgBox ("Yazdırılamıyor !" & vbNewLine & _ "M56 hücresini boş bırakamazsınız.") Cancel = True End If End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Sheets("Sayfa1").Range("M56") = "" Then MsgBox ("Kaydedilemiyor!" & vbNewLine & _ "M56 hücresini boş bırakamazsınız.") Cancel = True End If End Sub