Kitabın başlığını değiştirme

Sub test()
   Application.Caption = "Excelci"
ActiveWindow.Caption = "pirr"
   'Incorrect
   MsgBox Application.Caption & " " & ActiveWindow.Caption
   'Correct
   MsgBox Application.Caption
 End Sub

Excel'de çalışma kitabını otomatik kaydetme

ÇALIŞMA KİTABINI KAPATTIĞINIZDA KİTABI OTOMATİK KAYIT YAPAR VEYA YAPMAZ
Sub Auto_close()
Workbooks("Kitap1.xls").Close True 'False kaydetmeden kitabı kapar
End Sub

Excel de sayfadaki e-mail adreslerinin ayıklanması makrosu

Sub ayikla()
    For x = 1 To [a65536].End(3).Row
    d = Split(Cells(x, 1))
        For Each elem In d
            If InStr(elem, "@") Then
                a = a + 1
                Sheets("sayfa2").Cells(a, 1) = Trim(Replace(Replace(Replace(elem, ",", ""), "e-mail:", ""), Chr(160), ""))
            End If
        Next elem
    Next x
        Sheets("sayfa2").Select
End Sub

Dosya düzen çubuğuna menü ekleme silme

Modüle

Option Explicit

Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
' may be automatically executed from an Auto_Open macro or a Workbook_Open eventmacro
Dim cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
    RemoveMenu ' delete the menu if it already exists
    ' create a new menu on an existing commandbar (the next 6 lines)
    Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&My menu"
        .Tag = "MyTag"
        .BeginGroup = False
    End With
    ' or add to an existing menu (use the next line instead of the previous 6 lines)
    'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
    If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...


    ' add menuitem to menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Menu Item1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
    End With


    ' add menuitem to menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Menu Item2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
    End With


    ' add a submenu
    Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Submenu1"
        .Tag = "SubMenu1"
        .BeginGroup = True
    End With


    ' add menuitem to submenu (or buttons to a commandbar)
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Submenu Item1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 71
        .State = msoButtonDown ' or msoButtonUp
    End With


    ' add menuitem to submenu (or buttons to a commandbar)
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Submenu Item2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 72
        .Enabled = False ' or True
    End With


    ' add a submenu to the submenu
    Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Submenu2"
        .Tag = "SubMenu2"
        .BeginGroup = True
    End With


    ' add menuitem to submenu submenu
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Submenu Item1"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 71
        .State = msoButtonDown ' or msoButtonUp
    End With


    ' add menuitem to submenu submenu
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Submenu Item2"
        .OnAction = ThisWorkbook.Name & "!Macroname"
        .Style = msoButtonIconAndCaption
        .FaceId = 72
        .Enabled = False ' or True
    End With


    ' add menuitem to menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Remove this menu"
        .OnAction = ThisWorkbook.Name & "!RemoveMenu"
        .Style = msoButtonIconAndCaption
        .FaceId = 463
        .BeginGroup = True
    End With
    Set cbSubMenu = Nothing
    Set cbMenu = Nothing
End Sub

Sub RemoveMenu()
' may be automatically executed from an Auto_Close macro or a Workbook_BeforeClose eventmacro
    DeleteCustomCommandBarControl "MyTag" ' deletes the new menu
End Sub

Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' deletes ALL occurences of commandbar controls with a tag = CustomControlTag
    On Error Resume Next
    Do
        Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
    Loop Until Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
    On Error GoTo 0
End Sub

Sub ShowHideMenu(MenuVisible As Boolean)
' may be automatically executed from an Workbook_Activate macro or a Workbook_Deactivate eventmacro
    ChangeControlVisibility "MyTag", MenuVisible ' toggles menu visibility
End Sub

Private Sub ChangeControlVisibility(CustomControlTag As String, MenuVisible As Boolean)
' toggles menu visibility
    On Error Resume Next
    Application.CommandBars.FindControl(, , CustomControlTag, False).Visible = MenuVisible
    On Error GoTo 0
End Sub

Sub Macroname()
' used by the menuitems created by the CreateMenu macro
    MsgBox "This could be your macro running!", vbInformation, ThisWorkbook.Name
End Sub

'Thisworkbook a

Private Sub Workbook_Activate()
    ShowHideMenu True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    RemoveMenu
End Sub

Private Sub Workbook_Deactivate()
    ShowHideMenu False
End Sub

Private Sub Workbook_Open()
    CreateMenu
End Sub

Rastgele sayı üretimi 2

 D1 hücresine üretmek istediğiniz rakamların naximum değerini yazınız. D2 hücresine ise kaç adet sayı üreteceğinizi yazınız.

Sub rastgele()
  Dim i As Integer
  Dim bul As Range

  Randomize

  If Range("D1").Value < Range("D2") Then
    MsgBox "D1 hücresinin değeri D2 hücresinden küçük olmamalı"
    Exit Sub
  ElseIf Range("D1").Value = "" Or Range("D2") = "" Then
    MsgBox " D1 VE D2 hücrelerine bir değer giriniz"
    Exit Sub
  End If

  Cells(1, 1).Value = Int((Range("D1") * Rnd) + 1)
  For i = 2 To Range("D2")
    Cells(i, 1).Value = Int((Range("D1") * Rnd) + 1)
    For Each bul In Range("A1:A" & Cells(i - 1, 1).Row)
      If Cells(i, 1).Value = bul.Value Then
        Cells(i, 1).Value = Int((Range("D1") * Rnd) + 1)
      End If
    Next bul
  Next i
End Sub

istenilen hücreye istenilen yazı yazılınca makroyu çalıştıran kod

Bu excel makrosunda A sütununa "hoop" yazınca Test fonksiyonu çağrılıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    If Target = "hoop" Then Call Test
End Sub
Sub Test()
    MsgBox "Biri Benimi Çağırdı:)", vbInformation
End Sub

Excel macro ile yeni bir çalışma sayfası açma ve isim verme

Sub SayfaEkle()
    ThisWorkbook.Sheets.Add
    Sheets(ActiveSheet.Name).Name =sheets("sayfa_adi"). [a1].value
End Sub

Bilgisayarda yüklü yazıcı olup olmadığını kontrol eden excel makrosu

Private Sub UserForm_Activate()
On Local Error GoTo hata
Show
Print "kağıt kaynağı"; Printer.PaperBin
Print "renk modu"; Printer.ColorMode
Print "kopya sayısı"; Printer.Copies
Print "Yazıcının ismi"; Printer.DeviceName
Print "sürücü"; Printer.DriverName
Print "çift yönlü yazma"; Printer.Duplex
Print "yataylık-dikeylik"; Printer.Orientation
Print "sayfa boyutu"; Printer.PaperSize
Print "kullanılan port"; Printer.Port
Print "basım kalitesi"; Printer.PrintQuality
Print "yazıcı varsayılan mı"; Printer.TrackDefault
Print "ölçekleme"; Printer.Zoom
hata:
MsgBox ("yüklü bir yazıcı yok veya yazınız açık değil")
End Sub