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


istediğiniz yerde istediğiniz uyariyi verdirin...

ID : 1231
ISLEM : istediğiniz yerde istediğiniz uyariyi verdirin...
MAKRO KODU : istediğiniz yerde istediğiniz uyarıyı verdirin... Kod: 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

istenen araliği temizler

ID : 1232
ISLEM : istenen araliği temizler
MAKRO KODU : İSTENİLEN ARALIKTAKİ VERİLERİ TEMİZLER Sub temizle() Range("a1:a20").Value = "" Range("b21:b23").Value = "" Range("a1").Select End Sub

istenen hücreye veri girme

ID : 1233
ISLEM : istenen hücreye veri girme
MAKRO KODU : BU KODLA İSTEDİĞİNİZ HÜCRELERE VERİ GİREBİLİRSİNİZ Sub başlıkyaz() Range("a1").Select ActiveCell.FormulaR1C1 = "ali" Range("b1").Select ActiveCell.FormulaR1C1 = "veli" Range("c1").Select ActiveCell.FormulaR1C1 = "selami" Range("d1").Select ActiveCell.FormulaR1C1 = "ayşe" Range("e1").Select ActiveCell.FormulaR1C1 = "fatma" Range("f1").Select ActiveCell.FormulaR1C1 = "lale" End Sub

istenilen hücreleri dikey yazdırır

ID : 1234
ISLEM : istenilen hücreleri dikey yazdırır
MAKRO KODU : Sub PrintRpt1() 'To control orientation Sheets(1).PageSetup.Orientation = xlLandscape Range("f7").PrintOut Copies:=1 End Sub

istenilen hücreye gitme

ID : 1235
ISLEM : istenilen hücreye gitme
MAKRO KODU : Sub hücresec() 'Gitmek istenilen hücreyi seçer Dim Rng As Range On Error Resume Next Set Rng = Application.InputBox(prompt:="Gitmek istediğiniz Hücreyi Yazınız", Type:=8) If Rng Is Nothing Then MsgBox "Seçimden vazgeçtiniz" Else Rng.Select End If End Sub

istenilen makronun kodlarının görülmesi

ID : 1236
ISLEM : istenilen makronun kodlarının görülmesi
MAKRO KODU : Sub ViewCode() Application.Goto Reference:="insertrow" End Sub

istenilen saat ve dakikada makro çalıştırma

ID : 1237
ISLEM : istenilen saat ve dakikada makro çalıştırma
MAKRO KODU : Sub Alarm() Dim beepat As String beepat = InputBox("Give Alarm at", "hh:mm:ss " & _ Format(Now, "mm:hh"), "17:00") If beepat = "" Then MsgBox "cancelled" Exit Sub End If Application.OnTime TimeValue(beepat), "BeepMe" End Sub

istenilen saat ve dakikada makro çalıştırma 2

ID : 1238
ISLEM : istenilen saat ve dakikada makro çalıştırma 2
MAKRO KODU : Sub CountDownTimer() Dim beepat As String beepat = InputBox("Count down Timer hh:mm:ss i.e. 10:00", _ "Time now is " & Format(Now, "hh:mm:ss"), "3:00") If beepat = "" Then MsgBox "cancelled" Exit Sub End If Application.OnTime (Now + TimeValue(beepat)), "BeepMe" End Sub Sub beepme() Beep Application.OnTime (Now + TimeSerial(0, 0, 0.8)), "beepme2" End Sub Sub beepme2() Beep Application.OnTime (Now + TimeSerial(0, 0, 0.8)), "beepme3" End Sub Sub beepme3() Beep End Sub

istenilen saatte çıktı alma

ID : 1239
ISLEM : istenilen saatte çıktı alma
MAKRO KODU : Sub ProgrammeLaMacroTime() ' lance MacroImpression à 10h25 heures Application.OnTime TimeValue("10:25:00"), "MacroImpression", , True End Sub Sub MacroImpression() 'cette macro imprime la feuille Feuil1 ThisWorkbook.Sheets("Feuil1").PrintOut End Sub

istenilen saatte makro çalıştırma

ID : 1240
ISLEM : istenilen saatte makro çalıştırma
MAKRO KODU : Sub date_macro() datemacro = InputBox("Örnek zaman " & Time & _ ". zamanı belirt o zamanda makro çalışsın?") If datemacro = "" Then Exit Sub Application.OnTime TimeValue(datemacro), "makro1" 'makro1 isimli makro çalışır End Sub Sub makro1() MsgBox "makro1 çalıştı" End Sub

istenilen sayfa isminden başkasını eklemez

ID : 1241
ISLEM : istenilen sayfa isminden başkasını eklemez
MAKRO KODU : Sub Abfrage() Dim sh Dim kw As String kw = InputBox("Bitte geben Sie Ihr Kennwort ein ...") If kw = "Meier" Then Sheets("Meier").Visible = True If kw = "Müller" Then Sheets("Müller").Visible = True If kw = "Schulz" Then Sheets("Schulz").Visible = True If kw = "Weber" Then Sheets("Weber").Visible = True If kw = "admin" Then For Each sh In ActiveWorkbook.Sheets If sh.Name "Auswahl" Then sh.Visible = True Next sh End If End Sub -

istenilen sayfadaki istenilen hücreye gitme

ID : 1242
ISLEM : istenilen sayfadaki istenilen hücreye gitme
MAKRO KODU : Sub AllerA() Application.Goto Reference:=Worksheets("Feuil1").Range("A154"), Scroll:=True End Sub

istenilen sayfalar haricinde gizleme

ID : 1243
ISLEM : istenilen sayfalar haricinde gizleme
MAKRO KODU : For a = 1 To Sheets.Count If Sheets(a).Name "GELİR İCMAL" And Sheets(a).Name "ANASAYFA" Then Sheets(a).Visible = xlVeryHidden Next -

istenilen sayfayi açabilmek

ID : 1244
ISLEM : istenilen sayfayi açabilmek
MAKRO KODU : Sub DENEME() Dim i As Double i = Sheets("ANASAYFA").Range("a1").Value Worksheets("" & i).Select End Sub

istenilen siteyi açma

ID : 1245
ISLEM : istenilen siteyi açma
MAKRO KODU : Sub excelerator() Dim MyShell As Object Set MyShell = CreateObject("WScript.Shell") MyShell.Run "http://www.excelerator.de" End Sub

istenilen sutunu gizlemek

ID : 1246
ISLEM : istenilen sutunu gizlemek
MAKRO KODU : istenilen sutun gizle-göster gizleme Kod: Sub Macro2() colx = InputBox("Hangi sutunu gizlemek istiyorsun?") ' Select Sheet1 and Sheet2 and make Sheet1 the active sheet. Sheets(Array("Sayfa1", "Sayfa2")).Select Sheets("Sayfa1").Activate ' Loop through each sheet in the selected sheets and hide column ' A on that sheet. For Each Sht In ActiveWindow.SelectedSheets Sht.Columns("" & colx & ":" & colx & "").Hidden = True Next End Sub göstermek: Kod: Sub Macro1() colx = InputBox("Hangi sutunu göstermek istiyorsun?") ' Select Sheet1 and Sheet2 and make Sheet1 the active sheet. Sheets(Array("Sayfa1", "Sayfa2")).Select Sheets("Sayfa1").Activate ' Loop through each sheet in the selected sheets and hide column ' A on that sheet. For Each Sht In ActiveWindow.SelectedSheets Sht.Columns("" & colx & ":" & colx & "").Hidden = false Next End Sub

istenilen sürece ekranda kalan userform

ID : 1247
ISLEM : istenilen sürece ekranda kalan userform
MAKRO KODU : Private Sub UserForm_Activate() ' Récupération de l'heure d'affichage de la BdD TimeDebut = Timer ' Donne la main à excel pour facilité l'affichage de la BdD DoEvents ' Boucle tant que 2 secondes ne se sont pas écoulé While Timer -

istenilen sürece ekranda kalan userform

ID : 1248
ISLEM : istenilen sürece ekranda kalan userform
MAKRO KODU : Private Sub UserForm_Activate() ' Récupération de l'heure d'affichage de la BdD TimeDebut = Timer ' Donne la main à excel pour facilité l'affichage de la BdD DoEvents ' Boucle tant que 2 secondes ne se sont pas écoulé While Timer -

istenilen sütunu gizleme

ID : 1249
ISLEM : istenilen sütunu gizleme
MAKRO KODU : Sub Macro2() colx = InputBox("Hangi sutunu gizlemek istiyorsun?") ' Select Sheet1 and Sheet2 and make Sheet1 the active sheet. Sheets(Array("Sayfa1", "Sayfa2")).Select Sheets("Sayfa1").Activate ' Loop through each sheet in the selected sheets and hide column ' A on that sheet. For Each Sht In ActiveWindow.SelectedSheets Sht.Columns("" & colx & ":" & colx & "").Hidden = True Next End Sub

istenilen sütunu gösterme

ID : 1250
ISLEM : istenilen sütunu gösterme
MAKRO KODU : Sub Macro1() colx = InputBox("Hangi sutunu göstermek istiyorsun?") ' Select Sheet1 and Sheet2 and make Sheet1 the active sheet. Sheets(Array("Sayfa1", "Sayfa2")).Select Sheets("Sayfa1").Activate ' Loop through each sheet in the selected sheets and hide column ' A on that sheet. For Each Sht In ActiveWindow.SelectedSheets Sht.Columns("" & colx & ":" & colx & "").Hidden = false Next End Sub

istenilen yazıcıyı aktif yapmak için

ID : 1251
ISLEM : istenilen yazıcıyı aktif yapmak için
MAKRO KODU : Sub PrinterSec() Application.ActivePrinter = "\\PRINTSERVER\HP LaserJet 1100 (MS) on Ne02:" End Sub Aşağıdaki kodları ThisWorkbook kısmına yazarak başka bir alternatifi de deneyebilirsiniz. Dosya açılırken belli bir yazıcı aktive edilmekte, kapanırken de başka bir yazıcı aktive edilmektedir. Private Sub Workbook_Open() Application.ActivePrinter = "Microsoft Office Document Image Writer on Ne01:" End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.ActivePrinter = "\\PRINTSERVER\HP LaserJet 1100 (MS) on Ne02:" End Sub

iş günlerini hesaplayan fonksiyon

ID : 1252
ISLEM : iş günlerini hesaplayan fonksiyon
MAKRO KODU : Function Isgunu(Bas_Trh As Date, Son_Trh As Date) Dim Say As Integer For mars = Son_Trh To Bas_Trh Step -1 If Weekday(mars, vbMonday) = 6 Then Say = Say + 1 If Weekday(mars, vbMonday) = 7 Then Say = Say + 1 Next mars Isgunu = (Son_Trh - Bas_Trh) + 1 - Say End Function '=Isgunu(A1;B1)

işgünlerine ait sheet açmak.

ID : 1253
ISLEM : işgünlerine ait sheet açmak.
MAKRO KODU : Sub Auto_Open() Dim tarih As Date, i As Integer 'tarih olarak sizin isgunu fonksiyonundan çıkan 'tarihi kullandım tarih = isgunu(Date) If Format(tarih, "mmmm-yy") & ".xls" ThisWorkbook.Name Then If MsgBox("Bu aya ait bir çalışma kitabı olmadığı için yeni sayfa açmadım.Şinci farklı kaydet yapacağım kabul mü?", vbYesNo) = vbYes Then ThisWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & Format(Date, "mmmm-yy") Sheets.Add.Name = Format(tarih, "dd-mm-yyyy") For Each sh In ThisWorkbook.Sheets If sh.Name Format(tarih, "dd-mm-yyyy") Then Application.DisplayAlerts = False 'veri varsa sormadan silecek. sh.Delete End If Next Exit Sub Else MsgBox "bu kitaba da yeni sayfa açmadım, farklı kaydette yapmadım, hiç bir şey yapmadım" Exit Sub End If End If Sayfaadi = Format(tarih, "dd-mm-yyyy") Application.DisplayAlerts = true For i = 1 To Sheets.Count If Sheets(i).Name = Sayfaadi Then Exit Sub Next i Sheets.Add.Name = Sayfaadi End Sub -

işgünlerine ait yeni sayfa oluşturma

ID : 1254
ISLEM : işgünlerine ait yeni sayfa oluşturma
MAKRO KODU : Sub Auto_Open() Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = Format(Date, "dd mm yy") End Sub

işlemci bilgilerini hücreye aktarma

ID : 1255
ISLEM : işlemci bilgilerini hücreye aktarma
MAKRO KODU : Sub InfoCPU() Dim MyOBJ As Object Dim MyCPU As Variant Dim MyMsg As String On Error Resume Next Set MyOBJ = GetObject("WinMgmts:").instancesOf _ ("Win32_Processor") If Err.Number 0 Then MsgBox "WMI yüklenmemiş! Programdan çıkılacak...", vbExclamation, _ "Windows Management Instrumentation" Exit Sub On Error GoTo 0 End If For Each MyCPU In MyOBJ [A1] = "İşlemci : " & Trim(MyCPU.Name) [A2] = "Üretici Firma : " & MyCPU.Manufacturer [A3] = "CPU ID : " & MyCPU.ProcessorId [A4] = "CPU hızı : " & MyCPU.CurrentClockSpeed [A5] = "Max CPU hızı : " & MyCPU.MaxClockSpeed Next End Sub -

işlemci hızı

ID : 1256
ISLEM : işlemci hızı
MAKRO KODU : Option Explicit Sub ProcessorSpeed() Dim objWMI As Object Dim Cpu As Object Set objWMI = GetObject("WinMgmts:").instancesOf("Win32_Processor") '// Don't forget the computer maybe multiprocessor! For Each Cpu In objWMI MsgBox Cpu.Name & " " & Cpu.CurrentClockSpeed & " Mhz", _ vbInformation Next Set objWMI = Nothing End Sub

işlemciyi uyutma

ID : 1257
ISLEM : işlemciyi uyutma
MAKRO KODU : Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Kullanımı; '1000 milisaniye kadar işlemciyi durdurur. "DoEvents" 'e benzer. Sub cal() Call Sleep(1000) End Sub

işletim sistemini öğrenme

ID : 1258
ISLEM : işletim sistemini öğrenme
MAKRO KODU : Function OSis32BIT() As Boolean OSis32BIT = False If InStr(Application.OperatingSystem, "32-bit") Then OSis32BIT = True End If End Function Sub TestOSis32BIT() If OSis32BIT Then MsgBox "You use a 32bit operating system", , _ Application.OperatingSystem Else MsgBox "You don't use a 32bit operating system", , _ Application.OperatingSystem End If End Sub

işlev ekle penceresi

ID : 1259
ISLEM : işlev ekle penceresi
MAKRO KODU : Sub Dialog_35() Application.Dialogs(xlDialogFunctionWizard).Show End Sub

jpeg resmi ekleme ve silme

ID : 1260
ISLEM : jpeg resmi ekleme ve silme
MAKRO KODU : Sub auto_open() Dim jpgekle As Object Set jpgekle = ActiveSheet.Pictures.Insert("C:\arnold.jpg") Application.Wait (Now + TimeSerial(0, 0, 10)) jpgekle.Delete End Sub

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