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


userforma alt simge durumunu küçültme ve ekranı kapla butonu ekler

ID : 2311
ISLEM : userforma alt simge durumunu küçültme ve ekranı kapla butonu ekler
MAKRO KODU : Private Declare Function FindWindowA Lib "User32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function EnableWindow Lib "User32" _ (ByVal hWnd As Long, ByVal bEnable As Long) As Long 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 Sub UserForm_Activate() EnableWindow FindWindowA("XLMAIN", Application.Caption), 1 End Sub Private Sub UserForm_Initialize() Dim hWnd As Long hWnd = FindWindowA(vbNullString, Me.Caption) SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000 End Sub

userforma alt simge durumunu küçültme ve ekrani kapla butonu ekler

ID : 2312
ISLEM : userforma alt simge durumunu küçültme ve ekrani kapla butonu ekler
MAKRO KODU : Private Declare Function FindWindowA Lib "User32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function EnableWindow Lib "User32" _ (ByVal hWnd As Long, ByVal bEnable As Long) As Long 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 Sub UserForm_Activate() EnableWindow FindWindowA("XLMAIN", Application.Caption), 1 End Sub Private Sub UserForm_Initialize() Dim hWnd As Long hWnd = FindWindowA(vbNullString, Me.Caption) SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000 End Sub

userforma farklı kaydet tuşu eklemek

ID : 2313
ISLEM : userforma farklı kaydet tuşu eklemek
MAKRO KODU : Userformunuza atayacağınız bir command button'a yazacağınız; Kod: Dim iChartType As Long Private Sub UserForm_Activate() 'Initialise the selections cb3D = True obColumn = True obBitmap = True End Sub Private Sub btnOK_Click() Unload Me End Sub Private Sub cb3D_Click() Select Case True Case obColumn obColumn_Click Case obLine obLine_Click Case obArea obArea_Click End Select End Sub Private Sub obColumn_Click() iChartType = IIf(cb3D, xl3DColumn, xlColumnClustered) UpdateChart End Sub Private Sub obLine_Click() iChartType = IIf(cb3D, xl3DLine, xlLine) UpdateChart End Sub Private Sub obArea_Click() iChartType = IIf(cb3D, xl3DArea, xlArea) UpdateChart End Sub Private Sub obBitmap_Click() UpdateChart End Sub Private Sub obMetafile_Click() UpdateChart End Sub Private Sub UpdateChart() Dim oCht As Chart, lPicType As Long 'Find the chart object on the sheet Set oCht = Sheet1.ChartObjects(1).Chart 'Recalculate the sheet to give us a new set of random points Sheet1.Calculate 'Do we want a metafile or a bitmap? 'If doing a 1 to 1 copy, xlBitmap will give a 'truer' rendition. 'If scaling the image, xlPicture will give better results lPicType = IIf(obMetafile, xlPicture, xlBitmap) 'Update the chart type and copy it to the clipboard, as seen on screen With oCht .ChartType = iChartType .CopyPicture xlScreen, lPicType, xlScreen End With 'Paste the picture from the clipboard into our image control Set imgChtPic.Picture = PastePicture(lPicType) End Sub Private Sub btnSave_Click() Dim vFile As Variant, sFilter As String, lPicType As Long, oPic As IPictureDisp 'Create an appropriate filter, based on the bitmap/picture option in the dialog sFilter = IIf(obMetafile, "Windows Metafile (*.emf),*.emf", "Windows Bitmap (*.bmp),*.bmp") 'Get the filename to save the bitmap to vFile = Application.GetSaveAsFilename(initialfilename:="", filefilter:=sFilter) If vFile False Then 'Get the type of bitmap lPicType = IIf(obMetafile, xlPicture, xlBitmap) 'Copy a picture on the chart with the correct format to the clipboard Sheet1.ChartObjects(1).Chart.CopyPicture xlScreen, lPicType, xlScreen 'Retrieve the picture from the clipboard... Set oPic = PastePicture(lPicType) '... and save it to the file SavePicture oPic, vFile End If End Sub -

userforma farkli kaydet tuşu

ID : 2314
ISLEM : userforma farkli kaydet tuşu
MAKRO KODU : Userformunuza atayacağınız bir command button'a yazacağınız; Kod: Dim iChartType As Long Private Sub UserForm_Activate() 'Initialise the selections cb3D = True obColumn = True obBitmap = True End Sub Private Sub btnOK_Click() Unload Me End Sub Private Sub cb3D_Click() Select Case True Case obColumn obColumn_Click Case obLine obLine_Click Case obArea obArea_Click End Select End Sub Private Sub obColumn_Click() iChartType = IIf(cb3D, xl3DColumn, xlColumnClustered) UpdateChart End Sub Private Sub obLine_Click() iChartType = IIf(cb3D, xl3DLine, xlLine) UpdateChart End Sub Private Sub obArea_Click() iChartType = IIf(cb3D, xl3DArea, xlArea) UpdateChart End Sub Private Sub obBitmap_Click() UpdateChart End Sub Private Sub obMetafile_Click() UpdateChart End Sub Private Sub UpdateChart() Dim oCht As Chart, lPicType As Long 'Find the chart object on the sheet Set oCht = Sheet1.ChartObjects(1).Chart 'Recalculate the sheet to give us a new set of random points Sheet1.Calculate 'Do we want a metafile or a bitmap? 'If doing a 1 to 1 copy, xlBitmap will give a 'truer' rendition. 'If scaling the image, xlPicture will give better results lPicType = IIf(obMetafile, xlPicture, xlBitmap) 'Update the chart type and copy it to the clipboard, as seen on screen With oCht .ChartType = iChartType .CopyPicture xlScreen, lPicType, xlScreen End With 'Paste the picture from the clipboard into our image control Set imgChtPic.Picture = PastePicture(lPicType) End Sub Private Sub btnSave_Click() Dim vFile As Variant, sFilter As String, lPicType As Long, oPic As IPictureDisp 'Create an appropriate filter, based on the bitmap/picture option in the dialog sFilter = IIf(obMetafile, "Windows Metafile (*.emf),*.emf", "Windows Bitmap (*.bmp),*.bmp") 'Get the filename to save the bitmap to vFile = Application.GetSaveAsFilename(initialfilename:="", filefilter:=sFilter) If vFile False Then 'Get the type of bitmap lPicType = IIf(obMetafile, xlPicture, xlBitmap) 'Copy a picture on the chart with the correct format to the clipboard Sheet1.ChartObjects(1).Chart.CopyPicture xlScreen, lPicType, xlScreen 'Retrieve the picture from the clipboard... Set oPic = PastePicture(lPicType) '... and save it to the file SavePicture oPic, vFile End If End Sub -

userforma kalan süre yazdir

ID : 2315
ISLEM : userforma kalan süre yazdir
MAKRO KODU : Private Sub Worksheet_Activate() bitis = 65000 baslangic = Now() For n = 2 To bitis Cells(n, 1).Value = n Cells(1, 1).Value = "İşleminiz yapılıyor. %" & Int(n * 100 / bitis) & " Tamamlandı !" Next Cells(1, 1).Value = "İşleminiz yapıldı. " & Int(((Now() - baslangic) * 24 * 60 * 60)) & " sn.de Tamamlandı !" End Sub

userforma x ya basınca mesaj gelir kapatmaz

ID : 2316
ISLEM : userforma x ya basınca mesaj gelir kapatmaz
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then MsgBox "Diese UserForm kann nur über den Button 'Beenden' geschlossen werden!", vbOKOnly, "Schliessen der UserForm erfolglos !!!" Cancel = True End If End Sub

userformda aktif sayfa adi

ID : 2317
ISLEM : userformda aktif sayfa adi
MAKRO KODU : Private Sub UserForm_Initialize() TextBox1.Value = ActiveSheet.Name Label1.Caption = ActiveSheet.Name End Sub Diğer nesneleride aynen uygulanabilir. Private Sub UserForm_Click() MsgBox ActiveSheet.Name End Sub

userform'da çalışan saat-takvimle birlikte

ID : 2318
ISLEM : userform'da çalışan saat-takvimle birlikte
MAKRO KODU : Private Sub UserForm_Activate() Do Label1.Caption = Format(Now, "dd.mm.yyyy - hh:mm:ss") DoEvents Loop End Sub Private Sub UserForm_DeActivate() UserForm_Activate False End Sub

userform'da çalişan saat-takvimle

ID : 2319
ISLEM : userform'da çalişan saat-takvimle
MAKRO KODU : Kod: Private Sub UserForm_Activate() Do Label1.Caption = Format(Now, "dd.mm.yyyy - hh:mm:ss") DoEvents Loop End Sub Private Sub UserForm_DeActivate() UserForm_Activate False End Sub

userformda hareketli gif

ID : 2320
ISLEM : userformda hareketli gif
MAKRO KODU : Private Sub UserForm_Initialize() WebBrowser1.Navigate "C:\Documents and Settings\xp\Belgelerim\Resimlerim\Resimlerim\Hareketli_resimler\0kop1.gif" WebBrowser2.Navigate "http://www.excel.web.tr/images/smiles/icon_hihoho.gif" End Sub

userform'da iskonto

ID : 2321
ISLEM : userform'da iskonto
MAKRO KODU : Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox7 = Format(TextBox7.Value, "#,##0.00") If IsNumeric(TextBox7) And IsNumeric(TextBox6) Then If TextBox11 "" Then TextBox8 = (CCur(TextBox7) - CCur(TextBox7) * CCur(TextBox11) / 100) * CCur(TextBox6) Exit Sub End If TextBox8 = CCur(TextBox7) * CCur(TextBox6) End If End Sub -

userform'da kapat butonu

ID : 2322
ISLEM : userform'da kapat butonu
MAKRO KODU : Private Sub CommandButton1_Click() Application.ScreenUpdating = False Unload Me ThisWorkbook.Save ThisWorkbook.Close End Sub

userformda resim önzileme

ID : 2323
ISLEM : userformda resim önzileme
MAKRO KODU : UserForm'a 1 adet Image ve 1 adet ComboBox ekleyip aşağıdaki kodları kopyalayıp yapıştırın. Resim seçmek için ComboBox'a çift tıklayıp çoklu seçim yapmanız ve Aç'a tıklamak yeterlidir. ComboBox'tan seçilen resim Image'de görünür. Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim FD As FileDialog Dim FFs As FileDialogFilters Dim stFileName As String Dim vaItem On Error GoTo Problem Set FD = Application.FileDialog(msoFileDialogOpen) With FD Set FFs = .Filters With FFs .Clear .Add "Pictures", "*.jpg" End With .AllowMultiSelect = True If .Show = False Then Exit Sub ComboBox1.Clear For Each vaItem In .SelectedItems ComboBox1.AddItem vaItem Next vaItem ComboBox1.ListIndex = 0 End With Exit Sub Problem: MsgBox "Geçerli bir resim dosyası değil." End Sub Private Sub ComboBox1_Change() Image1.Picture = LoadPicture(ComboBox1.Text) End Sub

userformda resim önzileme

ID : 2324
ISLEM : userformda resim önzileme
MAKRO KODU : UserForm'a 1 adet Image ve 1 adet ComboBox ekleyip aşağıdaki kodları kopyalayıp yapıştırın. Resim seçmek için ComboBox'a çift tıklayıp çoklu seçim yapmanız ve Aç'a tıklamak yeterlidir. ComboBox'tan seçilen resim Image'de görünür. Kod: Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim FD As FileDialog Dim FFs As FileDialogFilters Dim stFileName As String Dim vaItem On Error GoTo Problem Set FD = Application.FileDialog(msoFileDialogOpen) With FD Set FFs = .Filters With FFs .Clear .Add "Pictures", "*.jpg" End With .AllowMultiSelect = True If .Show = False Then Exit Sub ComboBox1.Clear For Each vaItem In .SelectedItems ComboBox1.AddItem vaItem Next vaItem ComboBox1.ListIndex = 0 End With Exit Sub Problem: MsgBox "Geçerli bir resim dosyası değil." End Sub Private Sub ComboBox1_Change() Image1.Picture = LoadPicture(ComboBox1.Text) End Sub

userformda saat

ID : 2325
ISLEM : userformda saat
MAKRO KODU : Private Sub UserForm_Activate() SAAT.Caption = Format(Time, "hh:mm:ss") End Sub

userformda saat

ID : 2326
ISLEM : userformda saat
MAKRO KODU : Sub saat() UserForm1.Label1 = Format(Now(), "dd/mm/yyyy - hh:mm") zaman = TimeValue(DateAdd("s", 60 - Second(Now()), Now())) Application.OnTime zaman, "saat", , True End Sub Private Sub UserForm_Activate() Module1.saat End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Application.OnTime zaman, "saat", , False End Sub

userformda saat, işlemci yormaması için 1dk bir kendini yeniler

ID : 2327
ISLEM : userformda saat, işlemci yormaması için 1dk bir kendini yeniler
MAKRO KODU : Module Global zaman Sub saat() UserForm1.Label1 = Format(Now(), "dd/mm/yyyy - hh:mm") zaman = TimeValue(DateAdd("s", 60 - Second(Now()), Now())) Application.OnTime zaman, "saat", , True End Sub 'Userform kısmına Private Sub UserForm_Activate() Module1.saat End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Application.OnTime zaman, "saat", , False End Sub

userformda takvim

ID : 2328
ISLEM : userformda takvim
MAKRO KODU : Userformun ilk açılışda takvimin bugünkü ayı göstermesi için Private Sub UserForm_Initialize() Calendar1.Year = Year(Now) Calendar1.Month = Month(Now) End Sub 'bir önceki ayı gösterecek commandbutton için; Private Sub CommandButton1_Click() If Month(Now) = 1 Then Calendar1.Year = Year(Now) - 1 Calendar1.Month = Month(Now) + 11 Exit Sub End If Calendar1.Year = Year(Now) Calendar1.Month = Month(Now) - 1 End Sub 'Şimdiye geri dönecek commandbutton için; Private Sub CommandButton2_Click() Calendar1.Year = Year(Now) Calendar1.Month = Month(Now) End Sub 'Bir sonraki ayı gösterecek commandbutton için; Private Sub CommandButton3_Click() If Month(Now) = 12 Then Calendar1.Year = Year(Now) + 1 Calendar1.Month = Month(Now) - 11 Exit Sub End If Calendar1.Year = Year(Now) Calendar1.Month = Month(Now) + 1 End Sub

userformda tarih

ID : 2329
ISLEM : userformda tarih
MAKRO KODU : combo1 de yıllar combo2 de aylar (1,2,...12) 31 tanede textbox oldugunu varsaydim. Kod: Private Sub ComboBox2_Change() If ComboBox2 = 12 Then x = DateDiff("d", "1" & "." & ComboBox2 & "." & ComboBox1, "1" & "." & "1" & "." & ComboBox1 + 1) Else x = DateDiff("d", "1" & "." & ComboBox2 & "." & ComboBox1, "1" & "." & ComboBox2 + 1 & "." & ComboBox1) End If z = 1 Dim ctrl As Control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "TextBox" Then ctrl.Text = "" End If Next ctrl For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "TextBox" Then ctrl.Text = z If z = x Then Exit For z = z + 1 End If Next ctrl End Sub

userformda toplama

ID : 2330
ISLEM : userformda toplama
MAKRO KODU : Private Sub CommandButton1_Click() TextBox1 = Val(TextBox2.Value) + Val(TextBox3.Value) End Sub

userformda x basınca çalışma kitabından çıkma

ID : 2331
ISLEM : userformda x basınca çalışma kitabından çıkma
MAKRO KODU : Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Workbooks("nomduclasseur.xls").Close False End Sub

userformda x işareti yok

ID : 2332
ISLEM : userformda x işareti yok
MAKRO KODU : Private Const WS_CAPTION As Long = &HC00000 Private Const WS_SYSMENU As Long = &H80000 Private Const WS_THICKFRAME As Long = &H40000 Private Const WS_MINIMIZEBOX As Long = &H20000 Private Const WS_MAXIMIZEBOX As Long = &H10000 Private Const WS_POPUP As Long = &H80000000 Private Const WS_VISIBLE As Long = &H10000000 Private Const WS_EX_DLGMODALFRAME As Long = &H1 Private Const WS_EX_APPWINDOW As Long = &H40000 Private Const WS_EX_TOOLWINDOW As Long = &H80 Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal ClassName As String, _ ByVal WindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal Index As Long) As Long Private Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal Index As Long, _ ByVal NewLong As Long) As Long Const GWL_STYLE = -16 Private Sub UserForm_Initialize() Dim hWnd As Long Dim Style As Long If Val(Application.Version) >= 9 Then hWnd = FindWindow("ThunderDFrame", Me.Caption) Else hWnd = FindWindow("ThunderXFrame", Me.Caption) End If Style = GetWindowLong(hWnd, GWL_STYLE) Style = (Style And Not WS_SYSMENU) SetWindowLong hWnd, GWL_STYLE, Style End Sub

userformdaki checkboxları sıfırlamak

ID : 2333
ISLEM : userformdaki checkboxları sıfırlamak
MAKRO KODU : Sub ResetAllCheckBoxesInUserForm() Dim ctrl As Control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "CheckBox" Then ctrl.Value = False End If Next ctrl End Sub

userformdaki commandbotton'a bul eklemek

ID : 2334
ISLEM : userformdaki commandbotton'a bul eklemek
MAKRO KODU : sub dosyabul() dim a as string a = application.findfile msgbox a end sub

userformdaki optionbuttonları sıfırlamak

ID : 2335
ISLEM : userformdaki optionbuttonları sıfırlamak
MAKRO KODU : Sub ResetAllOptionButtonsInUserForm() Dim ctrl As Control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "OptionButton" Then ctrl.Value = False End If Next ctrl End Sub

userformdaki textboxları sıfırlamak

ID : 2336
ISLEM : userformdaki textboxları sıfırlamak
MAKRO KODU : Sub ResetAllTextBoxesInUserForm() Dim ctrl As Control For Each ctrl In UserForm1.Controls If TypeName(ctrl) = "TextBox" Then ctrl.Text = "" End If Next ctrl End Sub

userformdan hücreye

ID : 2337
ISLEM : userformdan hücreye
MAKRO KODU : Private Sub TextBox1_Change() [a2] = TextBox1.Text End Sub

userformdan önizleme kapanınca forma dönme

ID : 2338
ISLEM : userformdan önizleme kapanınca forma dönme
MAKRO KODU : Private Sub CommandButton1_Click() UserForm1.Hide Worksheets("sayfa1").PrintPreview Worksheets("sayfa1").PageSetup.PrintArea = "" Application.Visible = False UserForm1.Show End Sub

userform'dan sayfaya bilgi girişi

ID : 2339
ISLEM : userform'dan sayfaya bilgi girişi
MAKRO KODU : UserForm kod modulüne: Kod: Private Sub CommandButton1_Click() Sheets("Sayfa1").Range("B" & ComboBox1.ListIndex + 2) = TextBox1 End Sub

userformdan userforma

ID : 2340
ISLEM : userformdan userforma
MAKRO KODU : C:\Den altında A ve B xls dosyalarım var. A userform1 de 5 tane commandbutton var B de de 5 tane userform var. Yapmak istediğim şu; A.xls Userform1 deki Commandbutton1 e tıklandığında B.xls deki userform1 açılsın Commandbutton2 e tıklandığında B.xls deki userform2 açılsın Commandbutton3 e tıklandığında B.xls deki userform3 açılsın Commandbutton4 e tıklandığında B.xls deki userform4 açılsın Commandbutton5 e tıklandığında B.xls deki userform5 açılsın ' Merhaba her iki dosyanın açık olması koşulu ile; Aşağıdaki kodu B.xls de bir Modüle yazın. Kod: Sub ac() UserForm1.Show End Sub Aşağıdaki koduda Butonunuzun olduğu sayfanın Kod bölümüne yazınız. Kod: Private Sub CommandButton1_Click() Application.Run "B.xls!ac" End Sub

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