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


bazı sayfaların listelenmesini engelleme

ID : 421
ISLEM : bazı sayfaların listelenmesini engelleme
MAKRO KODU : Private Sub UserForm_Activate() Dim i As Integer Dim j As Integer Label1.Caption = "" If Worksheets.Count = 1 Then Exit Sub For i = 1 To Worksheets.Count Sheets(i).Name = LCase(Sheets(i).Name) For j = i + 1 To Worksheets.Count If LCase(Worksheets(j).Name) ("ana sayfa") _ And LCase(Sheets(i).Name) ("toplam") _ And LCase(Sheets(i).Name) ("stok") _ And LCase(Sheets(i).Name) ("sayfa1") Then ComboBox1.AddItem Sheets(i).Name End If Next Sheets("ana sayfa").Move Before:=Sheets(2) -

beep sesi çıkartma

ID : 422
ISLEM : beep sesi çıkartma
MAKRO KODU : Option Explicit Declare Function Beep Lib "Kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long Sub Warnung() Beep 392, 200 Beep 494, 100 Beep 588, 200 Beep 740, 100 Beep 880, 400 Beep 740, 100 Beep 880, 900 End Sub

bekletme komutu

ID : 423
ISLEM : bekletme komutu
MAKRO KODU : ‘DoEvents kullanırsanız bekleme süresince program kilitlenmez. Dim basla Dim bekle basla = Timer bekle = 2 While Timer -

bekletmeli macro yapma durum çubuğunda

ID : 424
ISLEM : bekletmeli macro yapma durum çubuğunda
MAKRO KODU : Sub MsgBarreEtat() barreEtatEnregistrée = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Création du tarif catalogue.....Veuillez patienter, SVP....." '....exécution d'une macro (généralement long)..... Application.Wait Now + TimeValue("00:00:04") Application.StatusBar = False Application.DisplayStatusBar = barreEtatEnregistrée End Sub Sub MsgHeure() mheure = Time MsgBox ("Il est: " & mheure) End Sub

bekletmeli makro çalıştırma

ID : 425
ISLEM : bekletmeli makro çalıştırma
MAKRO KODU : Sub Pause() Application.OnTime Now+TimeValue("00:00:01"), "NextMacro" End Sub

bekletmeli mesaj

ID : 426
ISLEM : bekletmeli mesaj
MAKRO KODU : Sub bekletmeli_mesaj() MsgBox "Selamun Aleyküm OK !" saatsimdi = Hour(Now()) dakikasimdi = Minute(Now()) saniyesimdi = Second(Now()) + 10 zamansayaci = TimeSerial(saatsimdi, dakikasimdi, saniyesimdi) Application.Wait zamansayaci Beep MsgBox "Ve Aleyküm Selam! Kusura bakma 10 saniye sonra oldu ama." End Sub

bekletmeli ve aralara makro koyarak mesaj alma

ID : 427
ISLEM : bekletmeli ve aralara makro koyarak mesaj alma
MAKRO KODU : Sub StatusBarExample() Application.ScreenUpdating = False ' turns off screen updating Application.DisplayStatusBar = True ' makes sure that the statusbar is visible Application.StatusBar = "Please wait while performing task 1..." ' add some code for task 1 that replaces the next sentence Application.Wait Now + TimeValue("00:00:02") Application.StatusBar = "Please wait while performing task 2..." ' add some code for task 2 that replaces the next sentence Application.Wait Now + TimeValue("00:00:02") Application.StatusBar = False ' gives control of the statusbar back to the programme End Sub

belgelerim klasörünü aç alt+f4 ile kapat

ID : 428
ISLEM : belgelerim klasörünü aç alt+f4 ile kapat
MAKRO KODU : Sub LanceProgramme() ValRetour = Shell("C:\WINDOWS\EXPLORER.EXE", 1) Application.Wait Now + TimeValue("00:00:04") SendKeys "%{F4}", True ' Envoie Alt+F4 pour fermer l'application EXPLORER. End Sub

belgelerim klasörünü açma

ID : 429
ISLEM : belgelerim klasörünü açma
MAKRO KODU : Sub Lanc_Explorateur() Shell "explorer.exe", vbMaximizedFocus End Sub

beli sayfada true-false kontrolü

ID : 430
ISLEM : beli sayfada true-false kontrolü
MAKRO KODU : Aşağıdaki kodu thisworkbook sayfasına kopyalayarak deneyin. Private Sub Workbook_SheetActivate(ByVal Sh As Object) deg=IIf(ActiveSheet.Name = "Sayfa1", True, False) With Application .FixedDecimal =deg .FixedDecimalPlaces = 2 End With End Sub bu işlemi sayfa üzerinde buton ile yapmak istiyorsanız aşağıdaki kodları deneyebilirsiniz. Sub Button1_Click() If ActiveSheet.Name = "Sayfa1" Then With Application .FixedDecimal = True .FixedDecimalPlaces = 2 End With Else With Application .FixedDecimal = False .FixedDecimalPlaces = 2 End With End If MsgBox Application.FixedDecimal End Sub

belirlediğim verilerin klasör, dosyaadi olarak kaydi

ID : 431
ISLEM : belirlediğim verilerin klasör, dosyaadi olarak kaydi
MAKRO KODU : Sayfa1'in kod bölümüne: Kod: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 19 And Target.Row = 8 Then [S1] = [S1] + 1 End If Call Islemler End Sub ChDir-MkDir.xls'nin Module1'ine; Kod: Sub Islemler() Application.DisplayAlerts = 0 On Error Resume Next VerilecekAd = Left(Sheets("Sayfa1").Range("S8"), 3) & 241 + Sheets("Sayfa1").Range("S1") MkDir "C:\Veriyedekle" MkDir "C:\Veriyedekle\" & VerilecekAd Workbooks.Add ChDir "C:\Veriyedekle\" & VerilecekAd VerilecekAd = VerilecekAd & ".xls" ActiveWorkbook.SaveAs VerilecekAd ActiveWorkbook.Close False Application.DisplayAlerts = 1 End Sub

belirlenen bölgede açılan userform

ID : 432
ISLEM : belirlenen bölgede açılan userform
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set MyIsect = Application.Intersect(Target, Range("A1:B5")) If Not MyIsect Is Nothing Then UserForm1.Show End Sub

'belirlenen hücre aralıklarında çift tıklama ile x işareti koyar ve kaldırır

ID : 433
ISLEM : 'belirlenen hücre aralıklarında çift tıklama ile x işareti koyar ve kaldırır
MAKRO KODU : Option Explicit 'Belirlenen hücre aralıklarında çift tıklama ile x işareti koyar ve kaldırır Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim RaBereich As Range Set RaBereich = Range("B3:P16,B19:P22") If Intersect(Target, RaBereich) Is Nothing Then Exit Sub Application.EnableEvents = False Cancel = True If Target.Value = "X" Then Target.Value = "" Else Target.Value = "X" End If Application.EnableEvents = True Set RaBereich = Nothing End Sub

belirlenen hücre araliğinin çiktisini almak

ID : 434
ISLEM : belirlenen hücre araliğinin çiktisini almak
MAKRO KODU : Sub Yaz() ActiveSheet.PageSetup.PrintArea = "$a$1:$h$30" ActiveSheet.PrintOut From:=1, Copies:=1, preview:=False, Collate:=True End Sub

belirli bir stundaki bilgileri silen bir macro ?

ID : 435
ISLEM : belirli bir stundaki bilgileri silen bir macro ?
MAKRO KODU : Private Sub metinayikla() Dim nums As String For i = 1 To Cells(65536, 1).End(xlUp).Row For b = 1 To Len(Cells(i, 1)) If IsNumeric(Mid(Cells(i, 1), b, 1)) = True Then nums = nums & Mid(Cells(i, 1), b, 1) End If Next b Cells(i, 1) = CLng(nums) nums = "" Next i End Sub

belirli bir süre ekranda bekleyen ve daha sonra kapan user form

ID : 436
ISLEM : belirli bir süre ekranda bekleyen ve daha sonra kapan user form
MAKRO KODU : Belirli Bir Süre ekranda bekleyen ve daha sonra kapan userform. Private Sub UserForm_Activate() TimeDebut = Timer DoEvents While Timer -

belirtilen ay bittiğinde yeni aya geçmeden önce, aşağıdaki eski aya ait sayfaları otomatik olarak silecek bir makro

ID : 437
ISLEM : belirtilen ay bittiğinde yeni aya geçmeden önce, aşağıdaki eski aya ait sayfaları otomatik olarak silecek bir makro
MAKRO KODU : Sub sayfasil() Application.DisplayAlerts = False For a = Sheets.Count To 1 Step -1 ad = Sheets(a).Name If IsNumeric(ad) = True And ad -

belirtilen yoldaki xls dosyalarını aktif hücreden itibaren listeler

ID : 438
ISLEM : belirtilen yoldaki xls dosyalarını aktif hücreden itibaren listeler
MAKRO KODU : Sub DateinamenAuflisten() Dim Dateiname As String, i As Integer Dateiname = Dir$("c:\*.xls") ‘uzantısını değiştirebilirsiniz .doc gibi veya c:\windows\ bu yolla da klasör içi de olabilir. Do While Dateiname "" ActiveCell.Offset(i, 0) = Dateiname i = i + 1 Dateiname = Dir$() Loop End Sub -

belli sayfalar (a , b ve c adlı sayfalar) haricindekileri silmek

ID : 439
ISLEM : belli sayfalar (a , b ve c adlı sayfalar) haricindekileri silmek
MAKRO KODU : Sub GereksizSayfaSil() Application.DisplayAlerts = False For Each ws In Worksheets If ws.Name = "a" Or ws.Name = "b" Or ws.Name = "c" Then GoTo sonraki ws.Delete sonraki: Next Application.DisplayAlerts = True End Sub

belli sayfalar haricindeki sayfaları silme

ID : 440
ISLEM : belli sayfalar haricindeki sayfaları silme
MAKRO KODU : Sub GereksizSayfaSil() Application.DisplayAlerts = False For Each ws In Worksheets If ws.Name = "a" Or ws.Name = "b" Or ws.Name = "c" Then GoTo sonraki ws.Delete sonraki: Next Application.DisplayAlerts = True End Sub

belli sayfalar haricindeki sayfalari

ID : 441
ISLEM : belli sayfalar haricindeki sayfalari
MAKRO KODU : Pek çok sayfa olan dosyamızdaki örnek olarak a , b ve c adlı sayfalar haricindekileri silmek istersek; Kod: Sub GereksizSayfaSil() Application.DisplayAlerts = False For Each ws In Worksheets If ws.Name = "a" Or ws.Name = "b" Or ws.Name = "c" Then GoTo sonraki ws.Delete sonraki: Next Application.DisplayAlerts = True End Sub

belli sutunlarda çalişirken uyari

ID : 442
ISLEM : belli sutunlarda çalişirken uyari
MAKRO KODU : Her zaman söylediğim gibi geliştirmek sizin elinizde sutun B:B DEĞİLDE C:C OLABİLİR GİBİ Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Not Intersect(Target, Range("B:B")) Is Nothing Then MsgBox "Buraya istediğiniz uyarıyı yazıyorsunuz!", vbOKOnly, "www.excel.web.tr" End If End Sub Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Not Intersect(Target, Range("B:B")) Is Nothing Then MsgBox "Buraya istediğiniz uyarıyı yazıyorsunuz!", vbOKOnly, "www.excel.web.tr" End If End Sub

belli tarihlerde uyarı mesajı alma

ID : 443
ISLEM : belli tarihlerde uyarı mesajı alma
MAKRO KODU : Application.OnTime TimeValue("12:00:00"), "makro adı"

bilgisayar ismi

ID : 444
ISLEM : bilgisayar ismi
MAKRO KODU : Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Sub ComputerName() Dim lngTemp As Long, strPCName As String strPCName = Space(256) lngTemp = GetComputerName(strPCName, Len(strPCName)) MsgBox strPCName End Sub

bilgisayara bip sesleriyle melodi

ID : 445
ISLEM : bilgisayara bip sesleriyle melodi
MAKRO KODU : Option Explicit Declare Function Beep Lib "Kernel32" (ByVal Fq As Long, ByVal Tm As Long) As Long Sub Warnung() Beep 392, 200 Beep 494, 100 Beep 588, 200 Beep 740, 100 Beep 880, 400 Beep 740, 100 Beep 880, 900 End Sub

bir hücredeki kelimeyi arattirip sayisini bulma

ID : 446
ISLEM : bir hücredeki kelimeyi arattirip sayisini bulma
MAKRO KODU : Sub say() c = 0 For k = 3 To 5 'sütun numaraları, istediğiniz gibi ayarlayın For ara = 2 To WorksheetFunction.CountA(Columns(k)) If Cells(ara, k) Like "*" & [e2] & "*" Then c = c + 1 Next ara Next k [f2] = c 'neticenin yazdırılacağı hücreyi değiştirmek gerekebilir.. f2 yerine ist.hücre adresini girin End Sub

bir hücreye makro atamak

ID : 447
ISLEM : bir hücreye makro atamak
MAKRO KODU : Sadece C kolonundaki bir hücreye veri girişi olursa veya çift tıklanırsa bu durumda çalışacak makronuzu aşağıdaki iki kodun "......." yazan yerine kopyalayın. çift tıklama ile çalıştırmak için Kod: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If ActiveCell.Column = 3 Then '........ End If End Sub hücredeki değer değişince çalıştırmak için Kod: Private Sub Worksheet_Change(ByVal Target As Range) If ActiveCell.Column = 3 Then '........ End If End Sub her iki koduda ilgili sayfanın kod sayfasına yazınız.

bir hücreyi aktif hale getiren komut hangisi

ID : 448
ISLEM : bir hücreyi aktif hale getiren komut hangisi
MAKRO KODU : Yapacağınız işlem nümerik ise Macro1'i, alfanümerik ise Macro2'yi bir deneyin,işinizi görür sanırım. Kod: Sub Macro1() eklenecek = ActiveCell.Offset(1, 0) ActiveCell.Value = ActiveCell.Value + eklenecek End Sub Sub Macro2() eklenecek = ActiveCell.Offset(1, 0) ActiveCell.Value = ActiveCell.Value & eklenecek End Sub

bir kitaptaki sayfalari baska bir kitaba tasimak

ID : 449
ISLEM : bir kitaptaki sayfalari baska bir kitaba tasimak
MAKRO KODU : koddaki test.xls i gerekli isimle degistin basla kacinci sayfadan baslanacagini tane basladan sonra kac tane sayfa kopyalanacagini gosterir. Kod: Sub kopyala() Dim kitap As String Dim tane As Integer Dim basla As Integer basla = 1 tane = 2 kitap = ActiveWorkbook.Name For x = 1 To tane Workbooks(kitap).Sheets(basla).Move _ Before:=Workbooks("Test.xls").Sheets(1) Next End Sub not: soru basliginizi seceken "makro hakkinda" gibi cok amator bir baslik secmektense, " bir kitaptaki sayfalari baska bir kitaba tasimak" gibi ilk okundugunda anlasilacak sorulardan secmek cok daha hizli cevap almanizi saglar. aklinizda bulunsun. makro forumunda bir sorunun "makro hakkinda" olmamasi zaten imkansizdir.

bir sayfadaki veriyi diğer sayfalara kopyalamak

ID : 450
ISLEM : bir sayfadaki veriyi diğer sayfalara kopyalamak
MAKRO KODU : Sub deneme() Dim i As Integer For i = 1 To Worksheets.Count Worksheets(i).[a1].Value = Worksheets("sayfa1").[a1] Next i End Sub bu kod ile sayfa1 deki a1 hücresindeki veriyi diğer sayfalara atabilrsin

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