Makro Kod Listesi

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

ID : 2221
ISLEM : topla.çarpım worksheet.function karşılığ
MAKRO KODU : Bul = Evaluate("=SumProduct((B2:B65536 = ""A"") * (D2:D65536=""P""))")

ID : 2222
ISLEM : toplama formülü makro örnekleri
MAKRO KODU : ‘1. MySum = WorksheetFunction.Sum(Range("A1:A20")) MsgBox MySum ‘2. Range("a21") = WorksheetFunction.Sum(Range("a1:a20")) ‘3.. Range("A21").Formula = "=Sum(A1:A20)" ’4. Range("A21").Formula = "=topla(A1:A20)+S(" & Chr(34) & "Bu formül makro ile yazılmıştır" & Chr(34) & ")"

ID : 2223
ISLEM : toplamları sıfıra eşit olan satırları gizler
MAKRO KODU : Sub sıfırgizle() For Each rngRow In ActiveSheet.UsedRange.Rows If Application.Sum(rngRow) = 0 Then rngRow.EntireRow.Hidden = True End If Next rngRow End Sub

ID : 2224
ISLEM : treeview
MAKRO KODU : Private Sub TreeView1_Click() On Error GoTo son Dim bak As Range Dim a As String a = UserForm1.TreeView1.SelectedItem.Text If a <> "" Then Sayfa2.Select For Each bak In Sayfa2.Range("B2:B" & WorksheetFunction.CountA(Sayfa2.Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(a, vbUpperCase) Then ' .ComboBox1.Value, vbUpperCase) Then bak.Select With UserForm1 .TextBox1.Value = bak.Offset(0, 0) 'adı soyadı .TextBox4.Value = bak.Offset(0, 1) 'görevi .TextBox2.Value = bak.Offset(0, 3) 'tc kimlik no .TextBox3.Value = bak.Offset(0, 2) 'sicil no End With Exit Sub End If Next bak Else Exit Sub End If son: MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub

ID : 2225
ISLEM : treeview a eklediğimiz bir veriyi seçerek bunu çift tıklamayla aktif hücreye yazdır
MAKRO KODU : Private Sub TreeView1_DblClick() ActiveCell = TreeView1.SelectedItem.Text End Sub

ID : 2226
ISLEM : tuşa aktarılır gelen kutucuktaki değeri
MAKRO KODU : Sub Wert_aus_inputBox_in_A1() Cells(1, 1) = InputBox("Bitte geben Sie den Wert ein, der in Zelle A1 geschrieben werden soll:") End Sub

ID : 2227
ISLEM : tuşa aktarilir gelen kutucuktaki
MAKRO KODU : Sub Wert_aus_inputBox_in_A1() Cells(1, 1) = InputBox("Bitte geben Sie den Wert ein, der in Zelle A1 geschrieben werden soll:") End Sub

ID : 2228
ISLEM : tuşların ascii değerleri ve vba karşılıkları
MAKRO KODU : Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) MsgBox "Basılan Tuşun Ascii Değeri :" & KeyAscii End Sub

ID : 2229
ISLEM : tuşların keycode ları
MAKRO KODU : Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) MsgBox KeyCode End Sub

ID : 2230
ISLEM : tüm açıklamaları gizle göster
MAKRO KODU : Sub MsqXP() Application.DisplayCommentIndicator = xlCommentIndicatorOnly End Sub Sub AffXP() Application.DisplayCommentIndicator = xlCommentAndIndicator End Sub

ID : 2231
ISLEM : tüm araç çubuklarını listele
MAKRO KODU : Sub LstBO() 'Worksheets("LstBO").Select For Each cbar In CommandBars x = x + 1 [A1] = "Nom de la barre d'outils" [A1].Offset(x, 0) = cbar.Name [B1] = "Nom local de la barre d'outils" [B1].Offset(x, 0) = cbar.NameLocal [C1] = "Visible" [C1].Offset(x, 0) = cbar.Visible Next End Sub

ID : 2232
ISLEM : tüm checkbutton ları sıfırlar
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

ID : 2233
ISLEM : tüm dosya ve klasörlerde ara bul penceresini çağırma
MAKRO KODU : Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Const SW_SHOWNORMAL = 1 Sub FindAllFiles() Dim strPathToSearch As String strPathToSearch = "C:\" ShellExecute _ 0, _ "find", _ strPathToSearch, _ vbNullString, _ vbNullString, _ SW_SHOWNORMAL End Sub

ID : 2234
ISLEM : tüm excel dosyalarını açma
MAKRO KODU : Sub ShowFileOpenDialog() Dim i As Integer i = Workbooks.Count ' count of open workbooks Application.Dialogs(xlDialogOpen).Show ' displays the Open-dialog Select Case Workbooks.Count - i Case Is <= 0 ' no new workbooks opened MsgBox "You did not open any new workbooks!" Exit Sub Case 1 ' add your own code to work on the opened workbook MsgBox "You opened this workbook: " & ActiveWorkbook.Name Case Else ' add your own code to work on the opened workbooks MsgBox "You have opened " & Workbooks.Count - i & " workbooks." End Select End Sub

ID : 2235
ISLEM : tüm excel dosyasında yazdığımız tüm kodların silinmesini
MAKRO KODU : Sub hepsini_sil() If MsgBox("Projedeki bütün kodları siliyor dikkat etmek lazım." & vbCrLf & "Bütün kodlar silinsin mi?", vbYesNo, "AMAN DİKKAT!!!") = vbNo Then Exit Sub For Each modul In ThisWorkbook.VBProject.VBComponents With modul.codemodule .deletelines 1, .countoflines End With Next End Sub

ID : 2236
ISLEM : tüm formları kapatmak showmodal false olanları 1
MAKRO KODU : Sub Test() For i = UserForms.Count - 1 To 0 Step -1 Unload UserForms(i) Next End Sub

ID : 2237
ISLEM : tüm formları kapatmak showmodal false olanları 2
MAKRO KODU : Sub Test2() For Each MyForm In UserForms Unload MyForm Next MyForm End Sub

ID : 2238
ISLEM : tüm gizli satır ve sütunları gösterme
MAKRO KODU : Sub MasqueColonneLigne() On Error Resume Next Application.ScreenUpdating = False Numligne = InputBox(Prompt:="Taper les numéros de lignes. ( Ex. 8:12 - Maxi = 65536)") NumColonne = InputBox(Prompt:="Taper les numéros de colonnes. ( Ex. J:D - Maxi = IV )") Rows(Numligne).Select Selection.EntireRow.Hidden = True Columns(NumColonne).Select Selection.EntireColumn.Hidden = True End Sub

ID : 2239
ISLEM : tüm gizli sayfaları göster
MAKRO KODU : Sub Un_Hide_All() Dim sh As Worksheet For Each sh In Worksheets sh.Visible = True Next End Sub

ID : 2240
ISLEM : tüm gizli sayfaları göster
MAKRO KODU : Sub UnhideAllSheets() Dim wsSheet As Worksheet For Each wsSheet In ActiveWorkbook.Worksheets wsSheet.Visible = xlSheetVisible Next wsSheet End Sub

ID : 2241
ISLEM : tüm gizli sayfaları sırayla gösterir, mesaj verir göstereyim mi diye?
MAKRO KODU : Sub UnhideSomeSheets() Dim sSheetName As String Dim sMessage As String Dim Msgres As VbMsgBoxResult For Each wsSheet In ActiveWorkbook.Worksheets If wsSheet.Visible = xlSheetHidden Then sSheetName = wsSheet.Name sMessage = "Unhide the following sheet?" _ & vbNewLine & sSheetName Msgres = MsgBox(sMessage, vbYesNo) If Msgres = vbYes Then wsSheet.Visible = xlSheetVisible End If Next wsSheet End Sub

ID : 2242
ISLEM : tüm harfler büyük (yazım düzeni)
MAKRO KODU : Sub InGross() For Each c In Selection.Cells c.Value = UCase$(c.Value) Next c End Sub

ID : 2243
ISLEM : tüm harfler büyük yazım düzeni
MAKRO KODU : Sub UpperCase() Dim cell As Range For Each cell In Selection.Cells If cell.HasFormula = False Then cell = UCase(cell) End If Next End Sub

ID : 2244
ISLEM : tüm harfler küçük (yazım düzeni)
MAKRO KODU : Sub InKlein() For Each c In Selection.Cells c.Value = LCase$(c.Value) Next c End Sub

ID : 2245
ISLEM : tüm kitabı şifreleleme-şifreyi siz verin
MAKRO KODU : Sub ProtectAllSheets() Dim ws As Worksheet Dim sOrigSheet As String Dim sOrigCell As String Dim J As Integer Dim sPWord As String Application.ScreenUpdating = False sOrigSheet = ActiveSheet.Name sOrigCell = ActiveCell.Address sPWord = InputBox("What password?", "Protect All") If sPWord > "" Then For Each ws In Worksheets ws.Select ws.Protect Password:=sPWord Next ws End If Application.GoTo Reference:=Worksheets("" & sOrigSheet & "").Range("" & sOrigCell & "") Application.ScreenUpdating = True End Sub

ID : 2246
ISLEM : tüm kitabı ve sayfalarını şifreleme
MAKRO KODU : Sub ChartUnProtect() Dim wks As Worksheet Dim cht As Chart Dim chtObj As ChartObject Dim PW As String PW = "mypass" 'Unprotect all Chart sheets For Each cht In ActiveWorkbook.Charts Sheets(cht.Name).Unprotect password:=PW Next 'Unlock all Chart objects on each worksheet For Each wks In ActiveWorkbook.Worksheets wks.Unprotect password:=PW For Each chtObj In wks.ChartObjects wks.DrawingObjects(chtObj.Name).Locked = False Next wks.Protect password:=PW Next End Sub

ID : 2247
ISLEM : tüm kitabı ve sayfalarını şifreleme 2
MAKRO KODU : Sub ProtectAllSheets() Dim ws As Worksheet Dim sOrigSheet As String Dim sOrigCell As String Dim J As Integer Application.ScreenUpdating = False sOrigSheet = ActiveSheet.Name sOrigCell = ActiveCell.Address For Each ws In Worksheets ws.Select ws.Protect Password:="Password" Next ws Application.GoTo Reference:=Worksheets("" & sOrigSheet & "").Range("" & sOrigCell & "") Application.ScreenUpdating = True End Sub

ID : 2248
ISLEM : tüm kitapta istenilen sayfada sütunlardaki en son dolu hücreleri bildirir
MAKRO KODU : Thisworkbook'a Option Explicit Sub Zeilen_pro_Spalte_zaehlen() Dim x As Integer, y As Long For x = 1 To ActiveSheet.UsedRange.Columns.Count y = Cells(65536, x).End(xlUp).Row MsgBox "Sütun " & x & ", Satır " & y & " dolu hücredir" Next End Sub

ID : 2249
ISLEM : tüm kitapta seçili hücre sarı renkli
MAKRO KODU : Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range) Static OldIndex As Integer Static OldCell As Range On Error Resume Next OldCell.Interior.ColorIndex = OldIndex If Not OldCell Is Nothing Then OldIndex = Target.Interior.ColorIndex End If Target.Interior.ColorIndex = 6 Set OldCell = Target End Sub

ID : 2250
ISLEM : tüm klasör kopyalanıyor
MAKRO KODU : Sub Klasör_Kopyala() Dim ds Set ds = CreateObject("Scripting.FileSystemObject") ds.CopyFolder "D:\ExcelÖrnekleri", "C:\SXS" End Sub