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


formüllü hücreleri korumaya alır

ID : 931
ISLEM : formüllü hücreleri korumaya alır
MAKRO KODU : Sub Formul_bul_koru() Cells.Select Selection.Locked = False Selection.FormulaHidden = False Call ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Select Selection.Locked = True Selection.FormulaHidden = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

formüllü hücreleri silmeyi engelleme

ID : 932
ISLEM : formüllü hücreleri silmeyi engelleme
MAKRO KODU : Sayfanın kod bölümüne Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim oRange As Range Application.EnableEvents = False On Error GoTo Fehler: If Target.Cells.Count = 1 Then If Target.HasFormula Then MsgBox "In dieser Zelle befindet sich eine Formel oder ein Verweis." & vbLf & vbLf & " Ein Entfernen ist nur in der Bearbeitungsleiste möglich !", vbOKOnly, "http://www.excel-lex.de.vu" Application.OnKey "{del}", "" Else Application.OnKey "{del}" End If Else Set oRange = Target.SpecialCells(xlCellTypeFormulas) MsgBox "Es befinden sich Formeln oder Verweise im markierten Bereich." & vbLf & vbLf & " Ein Entfernen ist nur in der Bearbeitungsleiste möglich !", vbOKOnly, "http://www.excel-lex.de.vu" Application.OnKey "{del}", "" End If Aufraeumen: Application.EnableEvents = True Exit Sub Fehler: Application.OnKey "{del}" Resume Aufraeumen End Sub

formüllü hücreyi makroyla geri getirme

ID : 933
ISLEM : formüllü hücreyi makroyla geri getirme
MAKRO KODU : Option Explicit Type RangeCellInfo CellContent As Variant CellAddress As String End Type Public OrgWB As Workbook Public OrgWS As Worksheet Public OrgCells() As RangeCellInfo Sub EditRange() Dim i As Integer, cl As Range If TypeName(Selection) "Range" Then Exit Sub Application.ScreenUpdating = False ReDim OrgCells(Selection.Count) Set OrgWB = ActiveWorkbook Set OrgWS = ActiveSheet i = 1 For Each cl In Selection OrgCells(i).CellContent = cl.Formula OrgCells(i).CellAddress = cl.Address i = i + 1 Next cl Selection.Formula = "X" If Application.International(xlCountrySetting) = 47 Then Application.OnUndo "Angre endringer utført av makroen", "UndoEditRange" Else Application.OnUndo "Undo the latest macro", "UndoEditRange" End If End Sub Sub UndoEditRange() Dim i As Integer Application.ScreenUpdating = False On Error GoTo NoWBorWS OrgWB.Activate OrgWS.Activate On Error GoTo 0 For i = 1 To UBound(OrgCells) Range(OrgCells(i).CellAddress).Formula = OrgCells(i).CellContent Next i Set OrgWB = Nothing Set OrgWS = Nothing Erase OrgCells NoWBorWS: End Sub -

formüllü hücreyi seçmeden başka sayfaya değer olarak atamak

ID : 934
ISLEM : formüllü hücreyi seçmeden başka sayfaya değer olarak atamak
MAKRO KODU : Sub deger() Worksheets("Sayfa1").Range("A1").Copy Worksheets("Sayfa2").Range("A1").PasteSpecial Paste:=xlValues Application.CutCopyMode = False End Sub

formüllü ve tarihli kopyalama

ID : 935
ISLEM : formüllü ve tarihli kopyalama
MAKRO KODU : Sub DebutActivite() Dim Cel As Range ActiveSheet.Unprotect Set Cel = Range("B65536").End(xlUp).Offset(1, 0) With Cel .Value = Date .NumberFormat = "d-mmm-yy" .HorizontalAlignment = xlCenter With .Offset(0, 1) .Value = Now .NumberFormat = "hh:mm" .HorizontalAlignment = xlCenter End With End With End Sub Sub FinActivite() Dim Cel As Range Set Cel = Range("D65536").End(xlUp).Offset(1, 0) With Cel .Value = Now .NumberFormat = "hh:mm" .HorizontalAlignment = xlCenter With .Offset(0, 1) .FormulaR1C1 = "=RC[-1]-RC[-2]" '.Value = Time .NumberFormat = "hh:mm" .HorizontalAlignment = xlCenter End With End With ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End Sub

formülü değere dönüştürme

ID : 936
ISLEM : formülü değere dönüştürme
MAKRO KODU : Sub formuldegerlere () Application.ScreenUpdating = False Range("D7:AH27").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D7").Select Application.CutCopyMode = False Range("D7").Select Application.ScreenUpdating = True End Sub

framede adres bilgisi

ID : 937
ISLEM : framede adres bilgisi
MAKRO KODU : Bu işi framele yapmak istemenizin bir sebebi varmı? Label bu iş için daha kullanışlı. Framelerin yerine label yerleştirip aaşağıdaki kodu bir deneyin. visual basic kodu: -------------------------------------------------------------------------------- Private Sub ComboBox1_Change() ara = ComboBox1.Value alan = Sheets("KAYITLAR").Range("adresler") Label14.Caption = Application.WorksheetFunction.VLookup(ara, alan, 3, 0) End Sub

geçici dosya ismi alma

ID : 938
ISLEM : geçici dosya ismi alma
MAKRO KODU : Sub Geçici_Dosya_İsmi_Al() Dim ds, f Set ds = CreateObject("Scripting.FileSystemObject") f = ds.GetTempName MsgBox f End Sub

geçici dosyaya kaydetme

ID : 939
ISLEM : geçici dosyaya kaydetme
MAKRO KODU : Private Sub Workbook_Open() Dim StDatei As String Dim StPhad As String StDatei = ThisWorkbook.Name ' Dateiname StPhad = ThisWorkbook.Path ' Phad Dim Fso As Object Set Fso = CreateObject("Scripting.FileSystemObject") If Fso.FileExists(StPhad & "\" & Format(Now, "DD-MM-YY") & "_" & Format(Now, "hh-mm") & "_" & StDatei) Then Kill StPhad & "\" & Format(Now, "DD-MM-YY") & "_" & Format(Now, "hh-mm") & "_" & StDatei End If ActiveWorkbook.SaveCopyAs FileName:=StPhad & "\" & Format(Now, "DD-MM-YY") & "_" & Format(Now, "hh-mm") & "_" & StDatei End Sub

geçici klasörler

ID : 940
ISLEM : geçici klasörler
MAKRO KODU : Özel klasör isimleri alınıyor burada.Açıklama kodun içinde var. Sub Özel_Klasör_İsmi_Al() Dim ds, f Set ds = CreateObject("Scripting.FileSystemObject") Set f = ds.GetSpecialFolder(0) '0 Windows,1 Sistem,2 Geçici Klasörlerinin yerini verir. MsgBox f End Sub

geçiş seçenekleri penceresi

ID : 941
ISLEM : geçiş seçenekleri penceresi
MAKRO KODU : Sub Dialog_49() Application.Dialogs(xlDialogOptionsListsAdd).Show End Sub Sub Dialog_50() Application.Dialogs(xlDialogOptionsTransition).Show End Sub

genel seçenekleri penceresi

ID : 942
ISLEM : genel seçenekleri penceresi
MAKRO KODU : Sub Dialog_48() Application.Dialogs(xlDialogOptionsGeneral).Show End Sub

geri çalişan timer

ID : 943
ISLEM : geri çalişan timer
MAKRO KODU : Kodları modüle değil workbook içine yerleştirdiniz değilmi? (gözden kaçmış olabilir diye sordum). birde az önceki kodda dosyada tek sayfa varsa hata verecektir, onun yerine hücrelerin tamamını sildirebilirsiniz. Kod: Public AcZaman Private Sub Workbook_Open() AcZaman = Timer End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Application.DisplayAlerts = False SonZaman = Timer If SonZaman - AcZaman > 10 Then Range("a1:IV65536").Delete End If Application.DisplayAlerts = True End Sub

gif, jpg vs… resim ekleme

ID : 944
ISLEM : gif, jpg vs… resim ekleme
MAKRO KODU : Sub TestInsertPicture() InsertPicture "C:\Excel Programlama\PictureFileName.gif", Range("D10"), True, True 'uzantıyı değiştirerek diğer resim formatlarını da ekleyebilirsiniz. End Sub Sub InsertPicture(PictureFileName As String, TargetCell As Range, _ CenterH As Boolean, CenterV As Boolean) ' inserts a picture at the top left position of TargetCell ' the picture can be centered horizontally and/or vertically Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCell t = .Top l = .Left If CenterH Then w = .Offset(0, 1).Left - .Left l = l + w / 2 - p.Width / 2 If l -

gif, jpg vs… resmi hücreler arasına yerleştirme

ID : 945
ISLEM : gif, jpg vs… resmi hücreler arasına yerleştirme
MAKRO KODU : Sub TestInsertPictureInRange() InsertPictureInRange "C:\Excel Programlama\Arnold.gif", _ Range("B5:D10") End Sub Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) ' inserts a picture and resizes it to fit the TargetCells range Dim p As Object, t As Double, l As Double, w As Double, h As Double If TypeName(ActiveSheet) "Worksheet" Then Exit Sub If Dir(PictureFileName) = "" Then Exit Sub ' import picture Set p = ActiveSheet.Pictures.Insert(PictureFileName) ' determine positions With TargetCells t = .Top l = .Left w = .Offset(0, .Columns.Count).Left - .Left h = .Offset(.Rows.Count, 0).Top - .Top End With ' position picture With p .Top = t .Left = l .Width = w .Height = h End With Set p = Nothing End Sub -

girilen veri rakam dişinda bir şey olursa kullaniciyi uyararak tekrar rakam istesin

ID : 946
ISLEM : girilen veri rakam dişinda bir şey olursa kullaniciyi uyararak tekrar rakam istesin
MAKRO KODU : Sub hesaplama() zamoranı: z = InputBox("Zam oranını giriniz ! Ondalık kısmı varsa virgülle ayırınız !") If Not IsNumeric(z) Then GoTo zamoranı Cells(1, 23) = (z + 100) / 100 End Sub

girilen verinin aynisi varsa kaydetmesin

ID : 947
ISLEM : girilen verinin aynisi varsa kaydetmesin
MAKRO KODU : Private Sub CommandButton1_Click() Dim x As Boolean x = False For i = 1 To Sheets("sheet2").Cells(65536, 1).End(xlUp).Row If TextBox1.Text = Sheets("sheet2").Cells(i, 1) And TextBox2.Text = Sheets("sheet2").Cells(i, 2) Then x = True MsgBox ("Mükerrer kayıt") Exit For End If Next i If x = False Then Sheets("sheet2").Cells(i, 1) = TextBox1 Sheets("sheet2").Cells(i, 2) = TextBox2 End If End Sub

git penceresi

ID : 948
ISLEM : git penceresi
MAKRO KODU : Sub Dialog_33() Application.Dialogs(xlDialogFormulaGoto).Show End Sub

gitmek istenilen hücreyi seçer

ID : 949
ISLEM : gitmek istenilen hücreyi seçer
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

gizli açıklamayı göster (hücre seç)

ID : 950
ISLEM : gizli açıklamayı göster (hücre seç)
MAKRO KODU : Sub MSQCommentaire() Dim wks As Worksheet, MyCmt As Comment For Each wks In Worksheets For Each MyCmt In wks.Comments MyCmt.Visible = False ' Masque le commentaire MyCmt.Visible = True ' Affiche le commentaire Next MyCmt Next wks End Sub

gizli safaları gösterme

ID : 951
ISLEM : gizli safaları gösterme
MAKRO KODU : Sub gizligoster() Dim wsh As Worksheet For Each wsh In Sheets wsh.Visible = True Next wsh End Sub

gizli sayfada makro calisirmi

ID : 952
ISLEM : gizli sayfada makro calisirmi
MAKRO KODU : Çalışma Kitabında Sayfa1'i Gizlediğini varsayalım.. Fakat Dosyayı açan Kullanıcı Sayfa1'de işlem yapması gerekiyor veya sizin kodlarınız Sayfa1'de işlem yapması gerekiyor.. Kodlarınızın başına Kod: Sheets("Sayfa1").Visible = True yazdığınızda Gizli olan Sayfa1 açılıyor.. Ve Kodlarınızda yapılması gerekenler ne ise onu yapıyorsunuz,işi bittikten sonra yani kodların, Kod: Sheets("Sayfa1").Select 'Sayfayı seçiyor. ActiveWindow.SelectedSheets.Visible = False'Seçili sayfayı gizliyor.. Örnek Bir çalışma .. Burada Sayfa'in Gizli olması Gerek.. Kod: Sub deneme() Sheets("Sayfa1").Visible = True Sheets("Sayfa1").Select Range("A1").Value = "Bu Sayfa Gizlidir." Sheets("Sayfa1").Select 'Sayfayı seçiyor. ActiveWindow.SelectedSheets.Visible = False 'Seçili sayfayı gizliyor.. End Sub Kodu Çalıştırdıktan sonra Gizli Sayfayı açın. A1 Hücresine Bu Sayfa Gizlidir. yazısının yazıldığını göreceksiniz..

gizli sayfaları siler

ID : 953
ISLEM : gizli sayfaları siler
MAKRO KODU : Sub DeleteHiddenSheets() Dim sh As Worksheet Application.DisplayAlerts = False For Each sh In ThisWorkbook.Worksheets If sh.Visible xlSheetVisible Then sh.Visible = True sh.Delete End If Next sh Application.DisplayAlerts = True End Sub -

gizli sayfanın gösterimi için şifre sorulması

ID : 954
ISLEM : gizli sayfanın gösterimi için şifre sorulması
MAKRO KODU : Private Sub Workbook_SheetActivate(ByVal Sh As Object) If LCase(Sh.Name) = "sheet1" Or LCase(Sh.Name) = "sheet2" Then If InputBox("Şifreyi girin") "sifre" Then Sh.Visible = False End If End Sub -

gizli sayfayı yazdır

ID : 955
ISLEM : gizli sayfayı yazdır
MAKRO KODU : Sayfa gizliyken yapmak mümkün değil ama 'Sayfa görünür hale getirip 'Çıktısını alıp 'Tekrar gizlerken 'Bu işlemlerin gözükmemesi için kodlarınız başına application.screenuptading = false

gizli tüm tüm sayfalari göster

ID : 956
ISLEM : gizli tüm tüm sayfalari göster
MAKRO KODU : GİZLİ OLAN TÜM SAYFALARI GÖSTER Sub Un_Hide_All() Dim sh As Worksheet For Each sh In Worksheets sh.Visible = True Next End Sub

görsel ve güzel bir userform

ID : 957
ISLEM : görsel ve güzel bir userform
MAKRO KODU : Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Private FensterRegion&, Region& Private Hauptfensternummer&, Clientfensternummer& Private dummy As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Const GW_CHILD = 5 Private Const WM_NCLBUTTONDOWN = &HA1 Private Const HTCAPTION = 2 Private Sub UserForm_Initialize() Call FensterOhneKopf End Sub Sub FensterOhneKopf() Dim Abmessung As RECT Dim Abmessung1 As RECT Dim Pos1x&, Pos1y&, Pos2x&, Pos2y& If FensterRegion 0 Then Exit Sub UserForm1.BorderStyle = fmBorderStyleSingle Call Fensternummer(UserForm1, Abmessung, Abmessung1) Pos1x = 0 Pos1y = (Abmessung1.Top - Abmessung.Top) Pos2x = Abmessung.Right - Abmessung.Left Pos2y = Abmessung.Bottom - Abmessung.Top Region = CreateRectRgn(Pos1x, Pos1y, Pos2x, Pos2y) FensterRegion = SetWindowRgn(Hauptfensternummer, Region, True) End Sub 'Fensterhandles und Infos über Fenster holen Private Sub Fensternummer(Form As Object, Abmessung As RECT, Abmessung1 As RECT) Dim Fenstername$, Suchstring$ Suchstring = "UserForm ohne Titelzeile" Fenstername = Form.Caption Form.Caption = Suchstring Hauptfensternummer = FindWindow(vbNullString, Suchstring) Form.Caption = Fenstername Clientfensternummer = GetWindow(Hauptfensternummer, GW_CHILD) dummy = GetWindowRect(Hauptfensternummer, Abmessung) dummy = GetWindowRect(Clientfensternummer, Abmessung1) End Sub 'Folgendes ist notwendig, um die Form ohne Titelleiste zu verschieben Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 1 Then If Hauptfensternummer 0 Then dummy = ReleaseCapture() dummy = SendMessage(Hauptfensternummer, WM_NCLBUTTONDOWN, HTCAPTION, 0) End If Else Unload UserForm1 ' Zum schließen, beim ausprobieren. End If End Sub Private Sub CommandButton1_Click() Unload Me End Sub -

görünüm seçenekleri penceresi

ID : 958
ISLEM : görünüm seçenekleri penceresi
MAKRO KODU : Sub Dialog_25() Application.Dialogs(xlDialogDisplay).Show End Sub

gruplandır penceresi

ID : 959
ISLEM : gruplandır penceresi
MAKRO KODU : Sub Dialog_24() Application.Dialogs(xlDialogDemote).Show End Sub

güncelleştirme el ile

ID : 960
ISLEM : güncelleştirme el ile
MAKRO KODU : Sub guncelle() Application.AskToUpdateLinks = False ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources End Sub

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