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


userformunuza ekleyeceğiniz bir adet combobox'a ayları yazar

ID : 2371
ISLEM : userformunuza ekleyeceğiniz bir adet combobox'a ayları yazar
MAKRO KODU : Private Sub UserForm_Initialize() Dim i% Dim TMP$ ComboBox1.Clear For i = 1 To 12 TMP = Format(DateSerial(2004, i, 1), "mmmm") ComboBox1.AddItem TMP Next i ComboBox1.ListIndex = 0 End Sub

userformunuza ekleyeceğiniz bir adet combobox'a aylari yazar

ID : 2372
ISLEM : userformunuza ekleyeceğiniz bir adet combobox'a aylari yazar
MAKRO KODU : Private Sub UserForm_Initialize() Dim i% Dim TMP$ ComboBox1.Clear For i = 1 To 12 TMP = Format(DateSerial(2004, i, 1), "mmmm") ComboBox1.AddItem TMP Next i ComboBox1.ListIndex = 0 End Sub

userformunuzdadaki texbox'a yazdiğiniz veriler ayni anda excel çalişma sayfanizdaki a2 hücresine yazdirilir

ID : 2373
ISLEM : userformunuzdadaki texbox'a yazdiğiniz veriler ayni anda excel çalişma sayfanizdaki a2 hücresine yazdirilir
MAKRO KODU : Private Sub TextBox1_Change() [a2] = TextBox1.Text End Sub

userformunuzu yazdırmak

ID : 2374
ISLEM : userformunuzu yazdırmak
MAKRO KODU : Private Sub CommandButton1_Click() UserForm1.PrintForm End Sub

userformunuzu yazdirmak

ID : 2375
ISLEM : userformunuzu yazdirmak
MAKRO KODU : Gerekli olanlar 1 adet userform üzerine commanbutton, Commandbutton'a yazacağınız kod: Kod: Private Sub CommandButton1_Click() UserForm1.PrintForm End Sub

userformunuzun başlığı '+' şeklinde

ID : 2376
ISLEM : userformunuzun başlığı '+' şeklinde
MAKRO KODU : Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, ByVal _ lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _ As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _ As Long, ByVal dwNewLong As Long) As Long Private Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Integer, ByVal lParam As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal _ hWnd As Long) As Long Private wHandle As Long Private Sub UserForm_Initialize() On Error Resume Next Me.Caption = "pir" Image1.Visible = False If Val(Application.Version) >= 9 Then wHandle = FindWindow("ThunderDFrame", Me.Caption) Else wHandle = FindWindow("ThunderXFrame", Me.Caption) End If If wHandle = 0 Then Exit Sub hIcon = Image1.Picture SendMessage wHandle, &H80, True, hIcon SendMessage wHandle, &H80, False, hIcon frm = GetWindowLong(wHandle, -20) frm = frm And Not &H1 SetWindowLong wHandle, -20, frm DrawMenuBar wHandle End Sub

userformunuzun başlığını kodlarla istediğinizi şekilde ayarlayabilirsiniz

ID : 2377
ISLEM : userformunuzun başlığını kodlarla istediğinizi şekilde ayarlayabilirsiniz
MAKRO KODU : Private Sub UserForm_Initialize() UserForm1.Caption = "pir" End Sub

userformunuzun başliği '+' şeklinde

ID : 2378
ISLEM : userformunuzun başliği '+' şeklinde
MAKRO KODU : Userformun code bölümüne; Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String, ByVal _ lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _ As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _ As Long, ByVal dwNewLong As Long) As Long Private Declare Function SendMessage Lib "user32" Alias _ "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Integer, ByVal lParam As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal _ hWnd As Long) As Long Private wHandle As Long Private Sub UserForm_Initialize() On Error Resume Next Me.Caption = "www.excel.web.tr" Image1.Visible = False If Val(Application.Version) >= 9 Then wHandle = FindWindow("ThunderDFrame", Me.Caption) Else wHandle = FindWindow("ThunderXFrame", Me.Caption) End If If wHandle = 0 Then Exit Sub hIcon = Image1.Picture SendMessage wHandle, &H80, True, hIcon SendMessage wHandle, &H80, False, hIcon frm = GetWindowLong(wHandle, -20) frm = frm And Not &H1 SetWindowLong wHandle, -20, frm DrawMenuBar wHandle End Sub

userin başliği hareket eder

ID : 2379
ISLEM : userin başliği hareket eder
MAKRO KODU : Sub HarfHarf(ref As UserForm1) baslik = ref.Caption ref.Caption = "" For i = 0 To Len(baslik) If i = 0 Then ref.Caption = "" current = Timer Do While Timer - current -

uyan şartlara göre userform3'teki commandbutton gizlensin.

ID : 2380
ISLEM : uyan şartlara göre userform3'teki commandbutton gizlensin.
MAKRO KODU : Bu CommandButton3 butonu UserForm6'daki mi?Yoksa UserForm3'de ayrı bir CommandButton3'mi Var. Eğer UserForm3'de ayrı bir CommandButton3 var ise; UserForm''ün Initialize olayına visual basic kodu: -------------------------------------------------------------------------------- Private Sub UserForm_Initialize() CommandButton1.Visible = False End Sub -------------------------------------------------------------------------------- Yazmanız gerek ..AKsi halde UserForm6 Unload Me ile kapanacağından dediğiniz (UserForm6 Üzerindeyse CommandButton3) yapamazsınız.(*) Prensip olarak .Visible =True ve False ile gizlemeleri yapabilirsiniz. Gizlemeyipte Aktif veya Aktif olmamasını isterseniz .Enabled =True veya False yazmanız gerek. Kolay Gelsin.

uyarı mesajı (istediğin zaman, istediğin yerde)

ID : 2381
ISLEM : uyarı mesajı (istediğin zaman, istediğin yerde)
MAKRO KODU : Sub assist() Application.Assistant.Visible = True Assistant.Animation = msoAnimationIdle Set SB = Assistant.NewBalloon SB.Animation = msoAnimationCheckingSomething SB.BalloonType = msoBalloonTypeButtons SB.Heading = "istediğiniz uyarı!!" SB.Text = _ "Ich bin Dein persönlicher Assistent" If SB.Show = msoBalloonButtonOK Then Assistant.Visible = False End If end sub

uyarı mesajı 4 x şeklinde uyarı penceresi

ID : 2382
ISLEM : uyarı mesajı 4 x şeklinde uyarı penceresi
MAKRO KODU : Sub auto_open() Beep MsgBox "Mesaj Buraya!!", vbCritical, "Önemli" End Sub

uyarı mesajları 1

ID : 2383
ISLEM : uyarı mesajları 1
MAKRO KODU : Sub Dene() MsgBox "aa", 16, "hata" End Sub

uyarı mesajları 2

ID : 2384
ISLEM : uyarı mesajları 2
MAKRO KODU : Sub Denee() MsgBox "aa", 64, "hata" End Sub

uyarı mesajları 3 x şeklinde

ID : 2385
ISLEM : uyarı mesajları 3 x şeklinde
MAKRO KODU : Sub auto_open() Beep MsgBox "Mesaj Buraya!!", vbCritical, "Önemli" End Sub

uyarılı mesaj---100 tane beep ten sonra mesaj

ID : 2386
ISLEM : uyarılı mesaj---100 tane beep ten sonra mesaj
MAKRO KODU : Sub Meldung() For i = 1 To 100 Beep Next i Meld = MsgBox("Termin nicht vergessen!", 0, "A c h t u n g") End Sub

uyari kutucuğu!!

ID : 2387
ISLEM : uyari kutucuğu!!
MAKRO KODU : Sayfa koruması olan hücreler seçildiğinde uyarı mesajı veren bir kod oluşturulabilir. Aşağıdaki kodu sayfanın kod sayfasına kopyalayarak deneyin. Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.AllowEdit = False Then MsgBox "BU HÜCRE KORUMA ALTINDADIR" End Sub

uygulama başlığı

ID : 2388
ISLEM : uygulama başlığı
MAKRO KODU : Sub Title_Caption() Application.Caption = "Mahmut_Bayram" End Sub

uygulama ve kitap başlığı ayarlama

ID : 2389
ISLEM : uygulama ve kitap başlığı ayarlama
MAKRO KODU : sayfa kod bölümüne Option Explicit Public AppCap$ Public ActWinCap$ Private Sub Worksheet_Activate() Application.Caption = Worksheets(1).Range("A1").Value ActiveWindow.Caption = Worksheets(1).Range("B1").Value & " / " & _ Worksheets(1).Range("C1").Value & " / " & _ Worksheets(1).Range("D1").Value & " / " & _ Worksheets(1).Range("E1").Value End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.Caption = Worksheets(1).Range("A1").Value ActiveWindow.Caption = Worksheets(1).Range("B1").Value & " / " & _ Worksheets(1).Range("C1").Value & " / " & _ Worksheets(1).Range("D1").Value & " / " & _ Worksheets(1).Range("E1").Value End Sub 'ThisWorkbook a Option Explicit Public AppCap$ Public ActWinCap$ Private Sub Workbook_Activate() Application.Caption = Worksheets(1).Range("A1").Value ActiveWindow.Caption = Worksheets(1).Range("B1").Value & " / " & _ Worksheets(1).Range("C1").Value & " / " & _ Worksheets(1).Range("D1").Value & " / " & _ Worksheets(1).Range("E1").Value End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.Caption = AppCap ActiveWindow.Caption = ActWinCap End Sub Private Sub Workbook_Deactivate() Application.Caption = AppCap ActiveWindow.Caption = ActWinCap End Sub Private Sub Workbook_Open() Application.Caption = Worksheets(1).Range("A1").Value ActiveWindow.Caption = Worksheets(1).Range("B1").Value & " / " & _ Worksheets(1).Range("C1").Value & " / " & _ Worksheets(1).Range("D1").Value & " / " & _ Worksheets(1).Range("E1").Value End Sub

var olan menü çubuğuna buton ekleme

ID : 2390
ISLEM : var olan menü çubuğuna buton ekleme
MAKRO KODU : Private Sub Workbook_Open() Dim cmb As CommandBar Set cmb = Application.CommandBars("Standard") With cmb.Controls.Add(Type:=msoControlButton, _ Temporary:=True) .Caption = "Meine 1. Prozedur" .BeginGroup = True .FaceId = 59 .OnAction = "MeineProzedur1" End With With cmb.Controls.Add(Type:=msoControlButton, _ Temporary:=True) .Caption = "Meine 2. Prozedur" .FaceId = 49 .OnAction = "MeineProzedur2" End With Set cmb = Nothing End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim cmb As CommandBar Set cmb = Application.CommandBars("Standard") With cmb .Controls("Meine 1. Prozedur").Delete .Controls("Meine 2. Prozedur").Delete End With Set cmb = Nothing End Sub Sub MeineProzedur1() MsgBox Application.UserName End Sub Sub MeineProzedur2() MsgBox Now() End Sub

varolan kitabın içine kayıt

ID : 2391
ISLEM : varolan kitabın içine kayıt
MAKRO KODU : Sub test() GetValuesFromAClosedWorkbook "C:", "Book1.xls", _ "Sheet1", "A1:K30" End Sub Sub GetValuesFromAClosedWorkbook(fPath As String, _ fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange) .FormulaArray = "='" & fPath & "\[" & fName & "]" _ & sName & "'!" & cellRange .Value = .Value End With End Sub

varolan sayfaları a1 itibaren alt alta yazar

ID : 2392
ISLEM : varolan sayfaları a1 itibaren alt alta yazar
MAKRO KODU : Sub GetSheets() Dim j As Integer Dim NumSheets As Integer NumSheets = Sheets.Count For j = 1 To NumSheets Cells(j, 1) = Sheets(j).Name Next j End Sub

vb kodlari ile bir excel dosyasi aciyorum fakat bu excel dosyasindaki makroyu çalıştırma

ID : 2393
ISLEM : vb kodlari ile bir excel dosyasi aciyorum fakat bu excel dosyasindaki makroyu çalıştırma
MAKRO KODU : Run işlem yapabilmesi için çalıştırmak istediğiniz makronun bulunduğu Excel dosyasını daha önceden açmış olmalısınız Sub ExcelMakrosunuCalistir() Dim xlApp As Object Set xlApp = CreateObject("Excel.Application") xlApp.Run (FormAc) End Sub

vb kodlari ile bir excel dosyasi aciyorum fakat bu excel dosyasindaki makroyu çalıştırma2

ID : 2394
ISLEM : vb kodlari ile bir excel dosyasi aciyorum fakat bu excel dosyasindaki makroyu çalıştırma2
MAKRO KODU : Appication.Run(varsa argümanlar1, varsa argümanlar2)

vba da açalıştırırsan vba kitaplığını açar, sayfada kullanırsan 7 şer kolon atlar

ID : 2395
ISLEM : vba da açalıştırırsan vba kitaplığını açar, sayfada kullanırsan 7 şer kolon atlar
MAKRO KODU : Sub DatenUmwandeln() Dim MyRange As Range Dim Cell As Range Application.ScreenUpdating = False Set MyRange = ActiveCell.CurrentRegion.Columns(7) For Each Cell In MyRange Cell.Select Application.SendKeys "{F2}+{ENTER}", True Next Cell End Sub

vba daki sırayı takip ederek sayfa isimlerini otomatik sıralar

ID : 2396
ISLEM : vba daki sırayı takip ederek sayfa isimlerini otomatik sıralar
MAKRO KODU : Sub Auto_Open() Dim i As Integer Dim j As Integer If Worksheets.Count = 1 Then Exit Sub For i = 1 To Worksheets.Count - 1 For j = i + 1 To Worksheets.Count If Worksheets(j).Name -

vba kodlarını görme makrosu

ID : 2397
ISLEM : vba kodlarını görme makrosu
MAKRO KODU : Sub ViewCode() Application.Goto Reference:="Makro1" End Sub

vba kodunu görmek için butonla

ID : 2398
ISLEM : vba kodunu görmek için butonla
MAKRO KODU : Bu kodu bir butona atayınız: Application.GoTo Reference:="test"

vba penceresinin açilmasini ve kodlara ulaşilmasini engelleyen ve açan kodlar

ID : 2399
ISLEM : vba penceresinin açilmasini ve kodlara ulaşilmasini engelleyen ve açan kodlar
MAKRO KODU : vba penceresinin açılmasını ve kodlara ulaşılmasını engelleyen ve açan kodlar Kod: Private Sub Workbook_Open() Application.VBE.MainWindow.Visible = False '// Close ALL windows 1st! CmdControl 1695, False '// Visual basics Editor CmdControl 186, False '// Macros... CmdControl 184, False '// Record New Macro... CmdControl 1561, False '// View Code CmdControl 1605, False '// Design Mode Application.OnDoubleClick = "Dummy" Application.CommandBars("ToolBar List").Enabled = False Application.OnKey "%{F11}", "Dummy" 'Workbooks.Open "C:\" 'add your stuff here ActiveWorkbook.RunAutoMacros xlAutoOpen End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) CmdControl 1695, True '// Visual basics Editor CmdControl 186, True '// Macros... CmdControl 184, True '// Record New Macro... CmdControl 1561, True '// View Code CmdControl 1605, True '// Design Mode Application.OnDoubleClick = "" Application.CommandBars("ToolBar List").Enabled = True 'thisone Application.OnKey "%{F11}", "" End Sub Sub CmdControl(Id As Integer, TF As Boolean) Dim CBar As CommandBar Dim C As CommandBarControl On Error Resume Next For Each CBar In Application.CommandBars Set C = CBar.FindControl(Id:=Id, recursive:=True) If Not C Is Nothing Then C.Enabled = TF Next End Sub Sub Dummy() MsgBox "Kısıtlı Menü" End Sub

vbs ile klasör işlemleri

ID : 2400
ISLEM : vbs ile klasör işlemleri
MAKRO KODU : 1-Klasör Oluşturma Kod: Sub Klasor_olustur() Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.CreateFolder("C:\YeniKlasor") End Sub 2-Klasör Adı Değiştirme Kod: Sub Klasor_ad_degistir() Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.MoveFolder "C:\YeniKlasor\eski_adi", "C:\YeniKlasor\yeni_adi" End Sub 3-Klasör Silme Kod: Sub Klasor_sil() Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.DeleteFolder ("C:\YeniKlasor") End Sub 4-Klasör Taşıma Kod: Sub Klasor_tasi() Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.MoveFolder "C:\YeniKlasor", "D:\YeniKlasor" End Sub 5-Klasör Kopyalama Kod: Sub Klasor_kopyala() Const OverWriteFiles = True Set objFSO = CreateObject("Scripting.FileSystemObject") objFSO.CopyFolder "C:\YeniKlasor", "C:\EskiKlasor", OverWriteFiles End Sub 6-Alt Klasör Listesi Kod: Sub Klasor_altklasor_listesi() Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\YeniKlasor") Set colSubfolders = objFolder.Subfolders For Each objSubfolder In colSubfolders MsgBox objSubfolder.Name, objSubfolder.Size Next End Sub

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