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


çalışma kitabına şifreli giriş

ID : 601
ISLEM : çalışma kitabına şifreli giriş
MAKRO KODU : Private Sub Workbook_Open() Application.DisplayAlerts = False Heute = Now Verfalldatum = #5/14/2003# 'Hier Verfalldatum im Format MM/TT/JJJJ eintragen If Verfalldatum "36" Then MsgBox " Das Kennwort ist ungültig," & Chr(13) & Chr(13) & "der Vorgang wird abgebrochen !" ThisWorkbook.Close End If MsgBox ("Registrierung erfolgreich") Application.DisplayAlerts = True End If End Sub -

çalışma kitabına şifreli giriş

ID : 602
ISLEM : çalışma kitabına şifreli giriş
MAKRO KODU : Private Sub Workbook_Open() Dim passwort As String passwort = InputBox("Bitte geben Sie das Passwort" & Chr(13) & Chr(13) & " für das Einfügen von Kommentaren ein:", "Passwortabfrage für das Einfügen von Kommentaren") If passwort "36" Then MsgBox " Das Kennwort ist ungültig," & Chr(13) & Chr(13) & "Sie dürfen keine Kommentare einfügen !" Application.CommandBars("Worksheet Menu Bar").Controls("Einfügen").Controls("Kommentar").Enabled = False Application.CommandBars("Cell").Controls("Kommentar einfügen").Enabled = False Exit Sub Else Application.CommandBars("Worksheet Menu Bar").Controls("Einfügen").Controls("Kommentar").Enabled = True Application.CommandBars("Cell").Controls("Kommentar einfügen").Enabled = True End If End Sub -

çalışma kitabındaki son kullanılmış hücre 1

ID : 603
ISLEM : çalışma kitabındaki son kullanılmış hücre 1
MAKRO KODU : ActiveCell.SpecialCells(xlLastCell).Select

çalışma kitabındaki son kullanılmış hücre 2

ID : 604
ISLEM : çalışma kitabındaki son kullanılmış hücre 2
MAKRO KODU : Son kaldığınız hücreyi "Static" bir değişkene atayabilirsiniz. Static sonhucre as Range Sub Kontrol() set sonhucre = "kontrol edilen hücre" .... End Sub 'geri döndüğünüzde sonhucre.select 'yazdığınızda bu hücre seçilecektir.

çalışma kitabını diskete yedekler

ID : 605
ISLEM : çalışma kitabını diskete yedekler
MAKRO KODU : Sub SaveWorkbookBackupToFloppyA() Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub Set awb = ActiveWorkbook If awb.Path = "" Then Application.Dialogs(xlDialogSaveAs).Show Else BackupFileName = awb.Name OK = False On Error GoTo NotAbleToSave If Dir("A:\" & BackupFileName) "" Then Kill "A:\" & BackupFileName End If With awb Application.StatusBar = "Saving this workbook..." .Save Application.StatusBar = "Saving this workbook backup..." .SaveCopyAs "A:\" & BackupFileName OK = True End With End If NotAbleToSave: Set awb = Nothing Application.StatusBar = False If Not OK Then MsgBox "Dosya Yedeklenemedi!", vbExclamation, ThisWorkbook.Name End If End Sub -

çalışma kitabını günün tarihi ile kaydeder - varsa farklı kaydeder

ID : 606
ISLEM : çalışma kitabını günün tarihi ile kaydeder - varsa farklı kaydeder
MAKRO KODU : Sub gününtarihi() Dim sFileName As String sFileName = Format(Now, "dd_mm_yyyy") + ".xls" ActiveWorkbook.SaveAs sFileName End Sub

çalışma kitabını hardiskinizin "c:\" bölümüne istediğiniz adla farklı kaydetmek

ID : 607
ISLEM : çalışma kitabını hardiskinizin "c:\" bölümüne istediğiniz adla farklı kaydetmek
MAKRO KODU : Sub Kayıtİsmi() ActiveWorkbook.SaveAs Filename:="C:\Mahmut.xls" End Sub

çalışma kitabını kaydet

ID : 608
ISLEM : çalışma kitabını kaydet
MAKRO KODU : Sub kayıt() ActiveWorkbook.Save End Sub

çalışma kitabını paylaştır penceresi

ID : 609
ISLEM : çalışma kitabını paylaştır penceresi
MAKRO KODU : Sub Dialog_27() Application.Dialogs(xlDialogFileSharing).Show End Sub

çalışma kitabını tam ekran yapıp küçültme

ID : 610
ISLEM : çalışma kitabını tam ekran yapıp küçültme
MAKRO KODU : Sub InTheMiddle() Dim dWidth As Double, dHeight As Double With Application .WindowState = xlMaximized dWidth = .Width dHeight = .Height .WindowState = xlNormal .Top = dHeight / 4 .Height = dHeight / 2 .Left = dWidth / 4 .Width = dWidth / 2 End With End Sub

çalışma kitabını uyarısız kapatma

ID : 611
ISLEM : çalışma kitabını uyarısız kapatma
MAKRO KODU : Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.DisplayAlerts = False ActiveWorkbook.Save End Sub

çalışma kitabının tümünü yazdırma

ID : 612
ISLEM : çalışma kitabının tümünü yazdırma
MAKRO KODU : Sub PrintAll() ThisWorkbook.PrintOut End Sub

çalışma kitabının yedeğini alıp kaydeder (bulunulan dizine)--- başına yedek yazar

ID : 613
ISLEM : çalışma kitabının yedeğini alıp kaydeder (bulunulan dizine)--- başına yedek yazar
MAKRO KODU : Sub SaveNow() SaveWithBackup ThisWorkbook.Save End Sub Sub SaveWithBackup() On Error Resume Next Dim Proceed As Long Proceed = MsgBox("Yedekleyip kaydetmek istiyor musunuz?" & vbNewLine & _ "Selecting No will save without Backup", vbYesNo) If Proceed = vbYes Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, CreateBackup:=True Application.DisplayAlerts = True End If End Sub

çalışma sayfanızda belli aralıktaki hücreler seçilemez

ID : 614
ISLEM : çalışma sayfanızda belli aralıktaki hücreler seçilemez
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Not Application.Intersect(Target, Range("A1:A100")) Is Nothing Then Cells(ActiveCell.Row, 2).Select MsgBox "Bu aralıktaki hücreler seçilemez!" End If End Sub

çalışma sayfanızdaki boş satırları siler

ID : 615
ISLEM : çalışma sayfanızdaki boş satırları siler
MAKRO KODU : Sub BosSatirlariSil() Dim LastRow As Long, r As Long LastRow = ActiveSheet.UsedRange.Rows.Count LastRow = LastRow + ActiveSheet.UsedRange.Row - 1 Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub

çalışma sayfanızı korur, otomatik süzler çalışır

ID : 616
ISLEM : çalışma sayfanızı korur, otomatik süzler çalışır
MAKRO KODU : Sub sayfayıkoru() ActiveSheet.Protect userinterfaceonly:=True ActiveSheet.EnableAutoFilter = True End Sub

çalişma kitabi şifreleme

ID : 617
ISLEM : çalişma kitabi şifreleme
MAKRO KODU : Sub auto_open() Static sayac As Integer Do If sayac = 3 Then ThisWorkbook.Close False Else If InputBox("Şifreyi girin") = "Buraya koymak istediğiniz şifreyi yazacaksınız!" Then GoTo devam Else sayac = sayac + 1 End If End If Loop devam: End Sub

çalişma kitabimi ,sayfam içinde yer alan bir butonla kapamak

ID : 618
ISLEM : çalişma kitabimi ,sayfam içinde yer alan bir butonla kapamak
MAKRO KODU : Sub kapat() ActiveWorkbook.Close End Sub

çalişma kitabinda sheet1 isimli sayfa modulunun name özelliğini mysh olarak değiştirir

ID : 619
ISLEM : çalişma kitabinda sheet1 isimli sayfa modulunun name özelliğini mysh olarak değiştirir
MAKRO KODU : Aşağıdaki kod, çalışma kitabında Sheet1 isimli sayfa modulunun Name özelliğini MySh olarak değiştirir. visual basic kodu: -------------------------------------------------------------------------------- Sub Test() Dim MyMod As Object For Each MyMod In ThisWorkbook.VBProject.VBComponents If MyMod.Name = "Sheet1" Then MyMod.Name = "MySh" Next End Sub

çalişma kitabinizin başliğini istediğiniz şekilde değiştirin

ID : 620
ISLEM : çalişma kitabinizin başliğini istediğiniz şekilde değiştirin
MAKRO KODU : Açıklama:Çalışma Kitabınızın Başlığını istediğiniz şekilde değiştirin Sub test() Application.Caption = "pir" ActiveWindow.Caption = "excel.web.tr" 'Incorrect MsgBox Application.Caption & " " & ActiveWindow.Caption 'Correct MsgBox Application.Caption End Sub

çalişma kitabinizin satir ve sutun gizleme

ID : 621
ISLEM : çalişma kitabinizin satir ve sutun gizleme
MAKRO KODU : Sub gızle() For i = 1 To ActiveWorkbook.Sheets.Count Sheets(i).Select ActiveWindow.DisplayHeadings = False Next End Sub göstermesi için: Sub goster() For i = 1 To ActiveWorkbook.Sheets.Count Sheets(i).Select ActiveWindow.DisplayHeadings = true Next End Sub

çalişma sayfalarini çalişma kitabi olarak kaydet

ID : 622
ISLEM : çalişma sayfalarini çalişma kitabi olarak kaydet
MAKRO KODU : Sub SayfaKaydet() Dim sayfa As Worksheet For Each sayfa In Worksheets sayfa.Copy ActiveWorkbook.SaveAs "C:\Documents and Settings\pir\Desktop\" & sayfa.Name & ".xls" ActiveWorkbook.Close False Next sayfa End Sub

çalişma sayfalarinizin isimleri de&

ID : 623
ISLEM : çalişma sayfalarinizin isimleri de&
MAKRO KODU : Module bölümüne; Global WCnt Global Sh(1 To 100) As Worksheet Global ShNames(1 To 100) As String 'workbooka; Public Sub Workbook_Open() Dim i As Integer WCnt = Worksheets.Count For i = 1 To WCnt ShNames(i) = Sheets(i).Name Set Sh(i) = Sheets(ShNames(i)) Next i End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim z As Integer For z = 1 To WCnt Sh(z).Name = ShNames(z) Next z End Sub

çalişma sayfanizdaki boş satirlari siler

ID : 624
ISLEM : çalişma sayfanizdaki boş satirlari siler
MAKRO KODU : Çalışma Sayfanızdaki Boş Satırları Siler Sub BosSatirlariSil() Dim LastRow As Long, r As Long LastRow = ActiveSheet.UsedRange.Rows.Count LastRow = LastRow + ActiveSheet.UsedRange.Row - 1 Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub

çalişma sayfanizdaki çalişma alaninizi belirleyen ve iptal eden macrolar

ID : 625
ISLEM : çalişma sayfanizdaki çalişma alaninizi belirleyen ve iptal eden macrolar
MAKRO KODU : Açıklama: Çalışma sayfanızdaki çalışma alanınızı belirleyen ve iptal eden macrolar. Kod: Sub LimiteDefilement() ActiveSheet.ScrollArea = "A1:A10" End Sub Sub RetablitDefilement() ActiveSheet.ScrollArea = "" End Sub

çalişma sayfanizdaki hücrenin değerlerine göre hücreler renklerle dolar

ID : 626
ISLEM : çalişma sayfanizdaki hücrenin değerlerine göre hücreler renklerle dolar
MAKRO KODU : Açıklama: Çalışma sayfanızdaki hücrenin değerlerine göre hücreler renklerle dolar Kod: 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

çalişma sayfanizi korur ancak otomatik süzler çalişir

ID : 627
ISLEM : çalişma sayfanizi korur ancak otomatik süzler çalişir
MAKRO KODU : Açıklama: Çalışma Sayfanızı korur ancak otomatik süzler çalışır Kod: Sub sayfayıkoru() ActiveSheet.Protect userinterfaceonly:=True ActiveSheet.EnableAutoFilter = True End Sub

çalişma sayfasini korumaya alir

ID : 628
ISLEM : çalişma sayfasini korumaya alir
MAKRO KODU : ÇALIŞMA SAYFASINI KORUMAYA ALIR Sub sayfayıkoru() ActiveSheet.Protect userinterfaceonly:=True ActiveSheet.EnableAutoFilter = True End Sub

çaliştiğim sayfanin sadece çalişilan kisminin görüntülenmesini nasil sağlarim

ID : 629
ISLEM : çaliştiğim sayfanin sadece çalişilan kisminin görüntülenmesini nasil sağlarim
MAKRO KODU : Aşağıdaki makroyu bir butona bağlarsanız taramanıza gerek kalmadan gizleme yapabilirsiniz. Sub gizle() Columns("K:IV").Hidden = True Rows("45:65536").Hidden = True End Sub tekrar göstermek için ise Sub göster() Columns("K:IV").Hidden = False Rows("45:65536").Hidden = False End Sub

çıft fonksiyonlu commandbutton

ID : 630
ISLEM : çıft fonksiyonlu commandbutton
MAKRO KODU : Private Sub CommandButton1_Click() If CommandButton1.Caption = "Çalıştır" Then CommandButton1.Caption = "Sorgu Gir" CommandButton1.Font.Bold = True CommandButton1.Font.Size = 15 Else CommandButton1.Caption = "Çalıştır" CommandButton1.Font.Bold = False CommandButton1.Font.Size = 20 End If End Sub Private Sub UserForm_Initialize() CommandButton1.Caption = "Sorgu Gir" End Sub

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