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


userformdan x ile çıkma geçersiz uyarı mesajı

ID : 2341
ISLEM : userformdan x ile çıkma geçersiz uyarı mesajı
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "UserForm kann nur mit Klick auf 'Beenden' geschlossen werden !" Cancel = True End If End Sub

userformdan x ile excel çıkış

ID : 2342
ISLEM : userformdan x ile excel çıkış
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Application.ScreenUpdating = False Workbooks("Combo örnekleri.xls").Close True End Sub

userformsuz combobox tryit e makro yolu verin

ID : 2343
ISLEM : userformsuz combobox tryit e makro yolu verin
MAKRO KODU : Option Base 1 Option Explicit Dim EB As Object, LB As Object Dim vaList As Variant Dim oldText As String Sub TryIt() Sheets("Dialog1").Show End Sub Sub SetEditBox() With ActiveDialog Set EB = .EditBoxes(1) Set LB = .ListBoxes(1) .Focus = EB.Name End With EB.Text = "" LB.ListIndex = 0 vaList = LB.List End Sub Sub EditBoxAction() Dim i As Variant Dim ebText As String, lbText As String Dim iNums As Integer Static fSendKeys As Boolean If fSendKeys = True Then fSendKeys = False Exit Sub End If fSendKeys = False ebText = EB.Text If ebText = "" Then LB.ListIndex = 0 Else i = Application.Match(ebText & "*", vaList, 0) If IsError(i) = False Then LB.ListIndex = i lbText = LB.List(i) If Len(ebText) > Len(oldText) Or Left(ebText, Len(oldText)) ebText Then iNums = Len(lbText) - Len(ebText) If iNums > 0 Then SendKeys Right(lbText, iNums) & "+{LEFT " & iNums & "}" fSendKeys = True End If End If Else LB.ListIndex = 0 End If End If oldText = ebText End Sub Sub ListBoxAction() With LB EB.Text = LB.List(LB.ListIndex) End With oldText = EB.Text ActiveDialog.Focus = "ebMonth" SendKeys "{RIGHT}" End Sub -

userformsuz diyalog kutusu

ID : 2344
ISLEM : userformsuz diyalog kutusu
MAKRO KODU : Option Base 1 Option Explicit '* Declare Windows API calls and data types - 16 Bit for Windows 3.x * 'Define a variable type to store the window coordinates Type typRect16 Left As Integer Top As Integer Right As Integer Bottom As Integer End Type 'Get the dimensions of the screen Declare Function GetSystemMetrics16 Lib "User" Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer 'Get the handle for a window Declare Function FindWindow16 Lib "User" Alias "FindWindow" (ByVal szClass$, ByVal szTitle$) As Integer 'Get the dimensions of the window Declare Sub GetWindowRect16 Lib "User" Alias "GetWindowRect" (ByVal hWnd As Integer, lpRect As typRect16) 'Set the dimensions of the window Declare Sub Movewindow16 Lib "User" Alias "Movewindow" (ByVal hWnd As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Integer) '* Declare Windows API calls and data types - 32 bit for Windows 95 and NT * 'Define a variable type to store the window coordinates Type typRect32 Left As Long Top As Long Right As Long Bottom As Long End Type 'Get the dimensions of the screen Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long 'Get the handle for a window Declare Function FindWindow32 Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Get the dimensions of the window Declare Function GetWindowRect32 Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As typRect32) As Long 'Set the dimensions of the window Declare Function Movewindow32 Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long Sub CentreDialog() If InStr(1, Application.OperatingSystem, "32") = 0 Then CentreDialog16 Else CentreDialog32 End If End Sub Sub CentreDialog16() On Error Resume Next '*** DIMENSION VARIABLES *** Dim tRect As typRect16 'Variables to retrieve the screen dimensions with GetSystemMetrics API. Dim iScreenWidth As Integer Dim iScreenHeight As Integer 'Variable to store the window handle with FindWindow API. Dim ihWnd As Integer 'Variables to calculate the new dimensions for the window. Dim iWidth As Integer Dim iHeight As Integer Dim iLeft As Integer Dim iTop As Integer 'Get the handle of the dialog box window - 'bosa_sdm_XL' is the class name 'for an Excel 5 dialog box. ihWnd = FindWindow16("bosa_sdm_XL", ActiveDialog.DialogFrame.Text) 'Only continue if a valid handle is returned If ihWnd 0 Then 'Get the width and height of the screen in pixels iScreenWidth = GetSystemMetrics16(0) iScreenHeight = GetSystemMetrics16(1) 'Get the dimensions of the dialog box window in pixels GetWindowRect16 ihWnd, tRect 'Calculate the width and height of the dialog box iWidth = Abs(tRect.Right - tRect.Left) iHeight = Abs(tRect.Top - tRect.Bottom) 'Calculate the new position of the dialog box in pixels iLeft = (iScreenWidth - iWidth) / 2 iTop = (iScreenHeight - iHeight) / 2 'Move the dialog box to the centre of the screen Movewindow16 ihWnd, iLeft, iTop, iWidth, iHeight, True End If End Sub Sub CentreDialog32() On Error Resume Next '*** DIMENSION VARIABLES *** Dim tRect As typRect32 'Variables to retrieve the screen dimensions with GetSystemMetrics API. Dim iScreenWidth As Long Dim iScreenHeight As Long 'Variable to store the window handle with FindWindow API. Dim ihWnd As Long 'Variables to calculate the new dimensions for the window. Dim iWidth As Long Dim iHeight As Long Dim iLeft As Long Dim iTop As Long 'Get the handle of the dialog box window - 'bosa_sdm_XL' is the class name 'for an Excel dialog box. ihWnd = FindWindow32("bosa_sdm_XL", ActiveDialog.DialogFrame.Text) 'If not found, it could be a later version of Excel, so try again If ihWnd = 0 Then ihWnd = FindWindow32("bosa_sdm_XL8", ActiveDialog.DialogFrame.Text) End If 'Only continue if a valid handle is returned If ihWnd 0 Then 'Get the width and height of the screen in pixels iScreenWidth = GetSystemMetrics32(0) iScreenHeight = GetSystemMetrics32(1) 'Get the dimensions of the dialog box window in pixels GetWindowRect32 ihWnd, tRect 'Calculate the width and height of the dialog box iWidth = Abs(tRect.Right - tRect.Left) iHeight = Abs(tRect.Top - tRect.Bottom) 'Calculate the new position of the dialog box in pixels iLeft = (iScreenWidth - iWidth) / 2 iTop = (iScreenHeight - iHeight) / 2 'Move the dialog box to the centre of the screen Movewindow32 ihWnd, iLeft, iTop, iWidth, iHeight, True End If End Sub Sub ShowDialog() ThisWorkbook.DialogSheets("Dialog1").Show End Sub -

userformsuz form menü sayfa seçme

ID : 2345
ISLEM : userformsuz form menü sayfa seçme
MAKRO KODU : Option Explicit Dim dlg As DialogSheet ' global variable Sub SheetNavigation() Dim ws As Worksheet Application.ScreenUpdating = False Set dlg = ActiveWorkbook.DialogSheets.Add With dlg.DialogFrame .Left = 0 .Top = 0 .Height = 300 ' dialog height .Width = 300 ' dialog width End With dlg.Buttons(1).Left = 245 ' position of button1 dlg.Buttons(2).Left = 245 ' position of button2 With dlg.ListBoxes.Add(10, 15, 230, 275) ' size of listbox For Each ws In ActiveWorkbook.Worksheets If ws.Visible Then .AddItem ws.Name Next ws .ListIndex = 0 .OnAction = "DisplaySheet" End With dlg.DialogFrame.Text = "Select the worksheet you want to activate" dlg.Visible = False Application.ScreenUpdating = True If dlg.Show Then Worksheets(dlg.ListBoxes(1).List(dlg.ListBoxes(1).ListIndex)).Activate End If Application.DisplayAlerts = False dlg.Delete Application.DisplayAlerts = True Set ws = Nothing Set dlg = Nothing End Sub Private Sub DisplaySheet() Sheets(dlg.ListBoxes(1).List(dlg.ListBoxes(1).ListIndex)).Activate End Sub

userformu alt+f4 ile kapatmak yasak

ID : 2346
ISLEM : userformu alt+f4 ile kapatmak yasak
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "Bitte mit dem Button 'Beenden' schließen!", vbOKOnly, "Websuche bei kmbuss.de" Cancel = True End If End Sub

userformu daraltma

ID : 2347
ISLEM : userformu daraltma
MAKRO KODU : Private Sub cmdStopAlarm_Click() Me.Height = 55 End Sub 'Userformu açma (daraltılanı) Private Sub cmdStopAlarm_Click() Me.Height = 185 End Sub

userformu kilitlemek 1

ID : 2348
ISLEM : userformu kilitlemek 1
MAKRO KODU : Private Sub UserForm_Activate() If InputBox("şifreyi giriniz") "pir" Then MsgBox ("Şifreyi bilemediniz.Bilgiler üzerinde degişiklik yapamazsınız.....!") TextBox1.Locked = True End If End Sub -

userformu kilitlemek 2

ID : 2349
ISLEM : userformu kilitlemek 2
MAKRO KODU : Private Sub UserForm_Activate() If InputBox("şifreyi giriniz") "pir" Then MsgBox ("Şifreyi bilemediniz:Form Kapatılacak..!") Unload Me End If End Sub -

userformu kilitlemek 3

ID : 2350
ISLEM : userformu kilitlemek 3
MAKRO KODU : Private Sub UserForm_Activate() ' Forma şifre koyma (şifre bilgisayarın saati) örnek (10:02) If InputBox("şifreyi giriniz") Mid(Time, 1, 5) Then MsgBox ("şifreyi bilemediniz.bilgiler üzerinde degişiklik yapamazsınız.") Text1.Locked = True End If End Sub -

userformu maksimize yapmak için

ID : 2351
ISLEM : userformu maksimize yapmak için
MAKRO KODU : Private Sub UserForm_Activate() Application.WindowState = xlMaximized Me.Left = Application.Width - Me.Width Me.Top = 0 End Sub

userformu otomatik boyutlandirma

ID : 2352
ISLEM : userformu otomatik boyutlandirma
MAKRO KODU : Private Sub UserForm_Initialize() With Application .WindowState = xlMaximized Zoom = Int(.Width / Me.Width * 100) Width = .Width Height = .Height End With End Sub Fullscren ile ama bu seferde userin üzerindeki nesneler farklılık gösterecek.Çözümü yok.VB Kullanırsan olur.. Bu kodları kod sayfanın en başına yazarsan 3 Düğme oluşur.Kullanıcı istediği gibi büyütür küçültür. Kod: 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 ShowWindow Lib "user32" _ (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long ' Private Sub UserForm_Activate() Dim hWndForm As Long, frmStyle As Long hWndForm = FindWindow(vbNullString, Me.Caption) frmStyle = GetWindowLong(hWndForm, (-16)) frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000 SetWindowLong hWndForm, (-16), frmStyle ShowWindow hWndForm, 5 DrawMenuBar hWndForm End Sub Ayrı bir kod ise Userformun açılışında tam ekran olarak gelmesi. Kod: Private Sub UserForm_Initialize() With Application Me.Top = .Top Me.Left = .Left Me.Height = .Height Me.Width = .Width End With End Sub

userformu tam ekran yapan kodlar

ID : 2353
ISLEM : userformu tam ekran yapan kodlar
MAKRO KODU : Private Sub UserForm_Initialize() With UserForm1 .Height = Application.Height .Width = Application.Width End With End Sub

userformu tam ekran yapan kodlar

ID : 2354
ISLEM : userformu tam ekran yapan kodlar
MAKRO KODU : Private Sub UserForm_Initialize() With UserForm1 .Height = Application.Height .Width = Application.Width End With End Sub

userformu tam ekran yapan kodlar 2

ID : 2355
ISLEM : userformu tam ekran yapan kodlar 2
MAKRO KODU : Private Sub UserForm_Initialize() UserForm1.Height = Application.Height UserForm1.Width = Application.Width End Sub

userform'un açılış sayısını sınırlamak (demo yapmak)

ID : 2356
ISLEM : userform'un açılış sayısını sınırlamak (demo yapmak)
MAKRO KODU : 1 adet UserForm '1 adet Label 'Aşağıdaki kodları UserForm'un kod bölümüne yapıştırınız. Dim webtr Private Sub UserForm_Activate() webtr = GetSetting("sınır", "sınırla", "webtr", 0) If webtr >= 5 Then 'burdaki 5 rakamı userformun kaç kere açılacağını belirtiyor. SaveSetting "sınır", "sınırla", "webtr", 111111 MsgBox "Üzgünüm UserForm 5 kere açılmış." & Chr(10) _ & "Aslanım herşeyin fazlası HARAM", vbOKOnly, "Uyarı" Unload Me End Else webtr = webtr + 1 SaveSetting "sınır", "sınırla", "webtr", webtr Label1.Caption = webtr & " oldu." End If End Sub

userformun başındaki kapat butonunu pasif yapar (çarpıya basınca userform kapanmaz)

ID : 2357
ISLEM : userformun başındaki kapat butonunu pasif yapar (çarpıya basınca userform kapanmaz)
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True End Sub

userformun başindaki kapat butonunu pasif yapar (çarpiya basinca userform kapanmaz)

ID : 2358
ISLEM : userformun başindaki kapat butonunu pasif yapar (çarpiya basinca userform kapanmaz)
MAKRO KODU : Açıklama: UserFormun başındaki kapat butonunu pasif yapar (çarpıya basınca userform kapanmaz) Kod: Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then Cancel = True End Sub Bu da UserFormun çarpı işaretine tıklayınca Mesaj kutusuyla uyarı veriyor Kod: Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "çarpıdan kapatmak yasaktır!" Cancel = True End If End Sub

userformun code bölümüne yapiştir,textbox'lari çoğaltabilirsin

ID : 2359
ISLEM : userformun code bölümüne yapiştir,textbox'lari çoğaltabilirsin
MAKRO KODU : Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If KeyAscii 57 Then KeyAscii = 0: MsgBox " Harf girilmeyecek,Sadece Rakam Giriniz ....." End Sub -

userformun çarpı işaretine tıklayınca mesaj kutusuyla uyarı veriyor

ID : 2360
ISLEM : userformun çarpı işaretine tıklayınca mesaj kutusuyla uyarı veriyor
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "çarpıdan kapatmak yasaktır!" Cancel = True 'Bu satır MsgBox tan önce de yazabilirsiniz End If End Sub

userformun esc ile kapanması, butonla da

ID : 2361
ISLEM : userformun esc ile kapanması, butonla da
MAKRO KODU : Private Sub CommandButton2_Click() Unload Me End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode 1 Then Cancel = True End Sub Private Sub UserForm_Initialize() CommandButton2.Cancel = True End Sub -

userformun esc ile kapatılması

ID : 2362
ISLEM : userformun esc ile kapatılması
MAKRO KODU : Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 27 Then Unload Me End Sub

userformun genişliği zaman ayarlı

ID : 2363
ISLEM : userformun genişliği zaman ayarlı
MAKRO KODU : Userformdaki optionbuttona aşağıdaki kodları Private Sub OptionButton1_Click() Me.Height = 153 zaman = Now + TimeValue("00:00:05") Application.OnTime zaman, "boyut" End Sub 'Bir module de aşağıdaki kodları yazın Sub boyut() UserForm4.Width = 320 End Sub

userformun kapandığı haliyle açılması

ID : 2364
ISLEM : userformun kapandığı haliyle açılması
MAKRO KODU : Private Sub UserForm_Initialize() TextBox1.Value = Range("A1").Value TextBox2.Value = Range("A2").Value TextBox3.Value = Range("A3").Value End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Range("A1").Value = TextBox1.Value Range("A2").Value = TextBox2.Value Range("A3").Value = TextBox3.Value End Sub

userformun kod bölümüne

ID : 2365
ISLEM : userformun kod bölümüne
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

userformun pasif olması

ID : 2366
ISLEM : userformun pasif olması
MAKRO KODU : UserForm'un Properties lerinden ShowModal kısmını False yaparsanız UserForm aktif iken hücrelerde gezebilirsiniz

userformun üst sağdaki kapat butonunu gizler

ID : 2367
ISLEM : userformun üst sağdaki kapat butonunu gizler
MAKRO KODU : Private Declare Function GetWindowLongA Lib "User32" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLongA Lib "User32" _ (ByVal hwnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function FindWindowA Lib "User32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Sub UserForm_Initialize() Dim hwnd As Long hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _ "X", "D") & "Frame", Me.Caption) SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF End Sub

userformun üst sağdaki kapat butonunu gizler

ID : 2368
ISLEM : userformun üst sağdaki kapat butonunu gizler
MAKRO KODU : Private Declare Function GetWindowLongA Lib "User32" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLongA Lib "User32" _ (ByVal hwnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function FindWindowA Lib "User32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Sub UserForm_Initialize() Dim hwnd As Long hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _ "X", "D") & "Frame", Me.Caption) SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF End Sub

userformun üzerinde 3 adet text box var ve textbox1 değerimiz 2. ve 3.nün toplmi olsun istiyoruz

ID : 2369
ISLEM : userformun üzerinde 3 adet text box var ve textbox1 değerimiz 2. ve 3.nün toplmi olsun istiyoruz
MAKRO KODU : Private Sub CommandButton1_Click() TextBox1 = Val(TextBox2.Value) + Val(TextBox3.Value) End Sub

userform'un yeri.

ID : 2370
ISLEM : userform'un yeri.
MAKRO KODU : maximize yapmak içinde Kod: Private Sub UserForm_Activate() Application.WindowState = xlMaximized Me.Left = Application.Width - Me.Width Me.Top = 0 End Sub

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