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


form kutusundan liste kutusuna komut verme

ID : 901
ISLEM : form kutusundan liste kutusuna komut verme
MAKRO KODU : Private Sub UserForm_Click() Sheets("günlük").Select TextBox1.Value = WorksheetFunction.Count(Range("a2:a65000")) + 1 TextBox2.SetFocus L = WorksheetFunction.CountA(Worksheets("günlük").Range("a1:a10000")) ListBox1.RowSource = "günlük!a1:a" & L ListBox1.ColumnCount = 12 ListBox1.RowSource = "günlük!a1:l" & L ' istatislikler yükleniyor Range("b2").Select TextBox2.Value = ActiveCell.Offset(0, 0).Value TextBox3.Value = ActiveCell.Offset(0, 1).Value TextBox4.Value = ActiveCell.Offset(0, 2).Value TextBox5.Value = ActiveCell.Offset(0, 3).Value TextBox6.Value = ActiveCell.Offset(0, 4).Value TextBox7.Value = ActiveCell.Offset(0, 5).Value TextBox8.Value = ActiveCell.Offset(0, 6).Value TextBox9.Value = ActiveCell.Offset(0, 7).Value TextBox10.Value = ActiveCell.Offset(0, 8).Value TextBox11.Value = ActiveCell.Offset(0, 9).Value TextBox12.Value = ActiveCell.Offset(0, 10).Value End Sub

form penceresi

ID : 902
ISLEM : form penceresi
MAKRO KODU : Formu açmak için şu kodları bir module yazabilirsiniz. Kod: Sub Makro1() Range("A1:C5").Select ActiveSheet.ShowDataForm End sub Formu açarken "Microsoft Excel bu komut için gereken sütun etiketlerini hangi listenin ya da seçimin içerdiğini belirleyemiyor" gibi bir uyarı çıkıyor ise şu kodları deneyin. Kod: Sub Makro1() Application.DisplayAlerts = False Range("A1:C5").Select ActiveSheet.ShowDataForm Application.DisplayAlerts = True End Sub

forma otomatik resim getirme

ID : 903
ISLEM : forma otomatik resim getirme
MAKRO KODU : Önce gösterilecek resimlerin isimleri bilgisayardan (Resimlerim klasörü)seçilerek sayfaya kaydediliyor. Daha sonra bu resimlerden gösterilmek istenen seçiliyor. Gerekli malzeme: 1 adet İmage1 1 adet CmdButon 1 adet cmbobox 1 adet Label1 'BU KOD EN BAŞA YAZILACAK 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 'BU KOD SAYFADAKİ ADRESTE BULUNAN RESİMLERİ GÖSTERİR Private Sub ComboBox1_Change() Image1.PictureSizeMode = fmPictureSizeModeZoom If ComboBox1.Value = "" Then MsgBox "Resim Yok", vbCritical Unload UserForm1 UserForm1.Show Exit Sub End If Label1.Caption = Cells(ComboBox1.ListIndex + 1, 1).Value 'seçim kutusundaki isim etikete yazılıyor Image1.Picture = LoadPicture(Label1.Caption) 'Etikette adresi gösterilen resim yükleniyor End Sub 'BU KOD İSTENİLEN RESİMLERİ SAYFAYA KAYIT EDER Private Sub CommandButton1_Click() Dim son As Integer Dim MyPic As Variant On Error Resume Next MyPic: MyPic = Application.GetOpenFilename("JPEG,*.jpg,GIF,*.gif,Bitmap, *.bmp") If MyPic False Then resim.PictureSizeMode = fmPictureSizeModeZoom resim.Picture = LoadPicture(MyPic) son = WorksheetFunction.CountA(Sheets("resimdata").Range("A:A")) + 1 'Resim adlarını sayfada depo ediyor. Sheets("resimdata").Cells(son, 1) = MyPic cevap = MsgBox(" " & MyPic & " kayıt edildi.Yeni resim eklemek istiyor musunuz?", vbExclamation + vbYesNo, "RESİM KAYIT") If cevap = vbYes Then GoTo MyPic End If End If End Sub 'BU KOD USERFORMA YAZILACAK Private Sub UserForm_Initialize() ComboBox1.RowSource = "resimdata!A:A" End Sub KOMPLE UYGULAMALI ÖRNEK 'BU KOD EN BAŞA YAZILACAK 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 'BU KOD COMBOBOX1 İÇİN Private Sub ComboBox1_Change() Image1.PictureSizeMode = fmPictureSizeModeZoom If ComboBox1.Value = "" Then MsgBox "Resim Yok", vbCritical Exit Sub End If Label1.Caption = Cells(ComboBox1.ListIndex + 1, 1).Value 'seçim kutusundaki isim etikete yazılıyor Image1.Picture = LoadPicture(Label1.Caption) 'Etikette adresi gösterilen resim yükleniyor End Sub 'BU KOD VERİLEN ADRESTEN RESİMİ SAYFAYA EKLER Private Sub CommandButton1_Click() cevap = MsgBox("BU İŞLEMİ YANLIZCA YETKİLİ KİŞİ YAPABİLİR ? YETKİNİZ YOKSA LÜTFEN VAZGEÇİN ! ", vbYesNo + vbQuestion + vbDefaultcmdsil + vbApplicationModal, "FORMA RESİM EKLER") If cevap = vbNo Then End End If Dim son As Integer Dim MyPic As Variant On Error Resume Next MyPic: MyPic = Application.GetOpenFilename("JPEG,*.jpg,GIF,*.gif,Bitmap, *.bmp") If MyPic False Then resim.PictureSizeMode = fmPictureSizeModeZoom resim.Picture = LoadPicture(MyPic) son = WorksheetFunction.CountA(Sheets("resimdata").Range("A:A")) + 1 'Resim adlarını sayfada depo ediyor. Sheets("resimdata").Cells(son, 1) = MyPic cevap = MsgBox(" " & MyPic & " kayıt edildi.Yeni resim eklemek istiyor musunuz?", vbExclamation + vbYesNo, "RESİM KAYIT") If cevap = vbYes Then GoTo MyPic End If End If End Sub 'BU KOD TEXTBOX1'DE VERİ ARATMAK İÇİN Private Sub CommandButton2_Click() On Error Resume Next Dim bak As Range For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then bak.Select ComboBox1.Value = ActiveCell.Offset(0, -1).Value ComboBox2.Value = ActiveCell.Offset(0, 1).Value TextBox3.Value = ActiveCell.Offset(0, 2).Value TextBox4.Value = ActiveCell.Offset(0, 3).Value TextBox5.Value = ActiveCell.Offset(0, 4).Value TextBox6.Value = ActiveCell.Offset(0, 5).Value TextBox7.Value = ActiveCell.Offset(0, 6).Value TextBox8.Value = ActiveCell.Offset(0, 7).Value Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub 'BU KOD EKRANI TEMİZLER Private Sub CommandButton3_Click() Unload UserForm1 UserForm1.Show End Sub 'BU KOD VERİLERİNİZDE YAPILAN DEĞİŞİKLİKLERİ KAYIT EDER Private Sub CommandButton4_Click() Dim bak As Range For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then bak.Select ActiveCell.Value = TextBox1.Value ActiveCell.Offset(0, 1).Value = ComboBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value ActiveCell.Offset(0, 3).Value = TextBox4.Value ActiveCell.Offset(0, 4).Value = TextBox5.Value ActiveCell.Offset(0, 5).Value = TextBox6.Value ActiveCell.Offset(0, 6).Value = TextBox7.Value ActiveCell.Offset(0, 7).Value = TextBox8.Value Workbooks("KADRO_.XLS").Save MsgBox "Verileriniz Başarıyla Değiştirildi", , "KAYIT" TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1 Unload UserForm1 UserForm1.Show Exit Sub End If Next bak End Sub 'BU KOD COMBOBOX2'DE VERİ ARATMAK İÇİN Private Sub CommandButton5_Click() On Error Resume Next Dim bak As Range For Each bak In Range("C1:C" & WorksheetFunction.CountA(Range("C1:C65000"))) If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox2.Value, vbUpperCase) Then bak.Select ComboBox1.Value = ActiveCell.Offset(0, -2).Value TextBox1.Value = ActiveCell.Offset(0, -1).Value TextBox3.Value = ActiveCell.Offset(0, 1).Value TextBox4.Value = ActiveCell.Offset(0, 2).Value TextBox5.Value = ActiveCell.Offset(0, 3).Value TextBox6.Value = ActiveCell.Offset(0, 4).Value TextBox7.Value = ActiveCell.Offset(0, 5).Value TextBox8.Value = ActiveCell.Offset(0, 6).Value Exit Sub End If Next bak MsgBox "Aradığınız isimde bir kayıt bulunamadı" End Sub 'BU KOD USERFORM İÇİN Private Sub UserForm_Initialize() ComboBox1.RowSource = "resimdata!A:A" Dim say As Integer Sheets("resimdata").Select If Range("c2") = "" Then say = WorksheetFunction.CountA(Range("B1:B65000")) ComboBox1.RowSource = "resimdata!c2:c" & say + 1 Else say = WorksheetFunction.CountA(Range("c1:c65000")) ComboBox2.RowSource = "resimdata!c2:c" & say End If ComboBox1.SetFocus End Sub -

formatli olarak girdiğim sayinin sifirlarini göremiyorum

ID : 904
ISLEM : formatli olarak girdiğim sayinin sifirlarini göremiyorum
MAKRO KODU : Private Sub CommandButton1_Click() TextBox1 = Format(TextBox1, "#,###") Cells(1, 1) = TextBox1.Value End Sub

formlarda x çikmaya izin vermez

ID : 905
ISLEM : formlarda x çikmaya izin vermez
MAKRO KODU : BU KODLAR FORM KAPARKEN X DAN ÇIKMAYA İZİN VERMEZ. Option Explicit Public a, d As Integer Private Sub CommandButton1_Click() d = 0 ActiveWorkbook.Save ActiveWorkbook.Close End Sub 'KAPAT BUTONUNA BASILDIĞINDA UYARI VERİR ENGELLER Private Sub UserForm_initialize() d = 1 End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If d = 1 Then MsgBox " kapat butonunu kullanınız.", vbCritical, "UYARI" Cancel = True End If End Sub 'BU KOD FORMUN ÇARPI İŞARETİNİ GİZLER 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 Declare Function FindWindowA Lib "User32" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Sub UserForm_Initialize() Dim hwnd As Long hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _ "X", "D") & "Frame", Me.Caption) SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF End Sub

formlardan birini kapar diğerini açar

ID : 906
ISLEM : formlardan birini kapar diğerini açar
MAKRO KODU : EKLENEN FORMLARIN BİRİNİ KAPAR İSTENİLENİ AÇAR. Private Sub CommandButton1_Click() UserForm1.Hide UserForm2.Show End Sub

formlardan birini kapayıp, diğerini açma

ID : 907
ISLEM : formlardan birini kapayıp, diğerini açma
MAKRO KODU : Private Sub CommandButton1_Click() UserForm1.Hide UserForm2.Show End Sub

formu kapama

ID : 908
ISLEM : formu kapama
MAKRO KODU : Private Sub CommandButton4_Click() End End Sub

formu kapar

ID : 909
ISLEM : formu kapar
MAKRO KODU : TABLOYU KAPAR Private Sub CommandButton4_Click() End End Sub

formu otomatik kapar

ID : 910
ISLEM : formu otomatik kapar
MAKRO KODU : FORMU OTOMATİK KAPAR Private Sub UserForm_Activate() Application.Wait Now + TimeSerial(0, 0, 3) Unload Me End Sub

formun sürüklenmesini engeller

ID : 911
ISLEM : formun sürüklenmesini engeller
MAKRO KODU : BU KODU FORMA YAZDIĞINIZDA FORM AÇILDIĞINDA FORMU SÜRÜKLEYEMEZSİNİZ. Private Sub UserForm_Layout() Me.Move Application.Width / 2 - Me.Width / 2, Application.Height / 2 - Me.Height / 2 End Sub

formunuzun başliğini kodlarla istediğinizi şekilde ayarlayabilirsiniz;

ID : 912
ISLEM : formunuzun başliğini kodlarla istediğinizi şekilde ayarlayabilirsiniz;
MAKRO KODU : Private Sub UserForm_Initialize() UserForm1.Caption = "www.excel.web.tr" End Sub

formül çevirici

ID : 913
ISLEM : formül çevirici
MAKRO KODU : Sub Formul_Convertor() Dim data As New DataObject Dim z As String On Error GoTo hata MsgBox Application.ConvertFormula( _ Formula:=ActiveCell.Formula, _ fromReferenceStyle:=xlR1C1, _ toReferenceStyle:=xlA1), vbInformation, "Normal Başvuru" z = Application.ConvertFormula( _ Formula:=ActiveCell.Formula, _ fromReferenceStyle:=xlA1, _ toReferenceStyle:=xlR1C1) MsgBox z, vbInformation, "R1C1 Stili" data.SetText z data.PutInClipboard Exit Sub hata: MsgBox ("Formül yok !!!"), vbCritical, "Başvurulan hücrede" End Sub

formül çoğaltma

ID : 914
ISLEM : formül çoğaltma
MAKRO KODU : Sub formulyaz() Application.ScreenUpdating = False Sheets(ComboBox1.Value).Activate [m11].Select Range("m11").Formula = "YUVARLA(J12 + L12) / 2,0)" [m11].Select Selection.AutoFill Destination:=[m11:m60], Type:=xlFillDefault [m11].Select '********* [n11].Select [n11].Formula = "=YAZIYLA(M11)" [n11].Select Selection.AutoFill Destination:=[N11:N60], Type:=xlFillDefault [n11].Select '********** End Sub

formül çoğaltma

ID : 915
ISLEM : formül çoğaltma
MAKRO KODU : Sub Summebilden() z = ActiveCell.Row For i = 1 To 7 Cells(z - 1 + i, 6).FormulaArray = _ "=SUM((r2c1:r23c2=1)*(r2c3:r23c3=" & i & ")*(r2c[-2]:r23c[-2]))" Next i End Sub

formül çoğaltma

ID : 916
ISLEM : formül çoğaltma
MAKRO KODU : Sub Minus() ActiveCell.FormulaR1C1 = "=RC[1]-R[-1]C[1]" Range(ActiveCell.Address & ":A" & [B65536].End(xlUp).Row).FillDown End Sub

formül çoğaltma dolu satıra göre

ID : 917
ISLEM : formül çoğaltma dolu satıra göre
MAKRO KODU : Sub Test() x = Cells(65536, 3).End(xlUp).Row Range("E2").AutoFill Destination:=Range("E2:E" & x) Application.Calculate End Sub

formül çoğaltma dolu satıra göre (formülle)

ID : 918
ISLEM : formül çoğaltma dolu satıra göre (formülle)
MAKRO KODU : e1 hücresine eğer(c2"";c2-e2;"") da yazıp sürükleyin -

formül çubuğunu kaldırma

ID : 919
ISLEM : formül çubuğunu kaldırma
MAKRO KODU : Application.DisplayFormulaBar=False - -> Formül çubuğu kaldırılır.

formül sonuna karakter ilave etme

ID : 920
ISLEM : formül sonuna karakter ilave etme
MAKRO KODU : Sub Formul_Sonuna_Karakter_Ilave_Et() Dim Hucre As Range karakter = InputBox("Formülün Sonuna Ekleyeceğiniz Karakteri Giriniz ?", "") For Each Hucre In Selection Hucre.Formula = Hucre.Formula & "&""" & karakter & """" Next End Sub

formülden değere, değerden formüle dönüşüm

ID : 921
ISLEM : formülden değere, değerden formüle dönüşüm
MAKRO KODU : Sub formulyaz() Application.ScreenUpdating = False Sheets(ComboBox2.Value).Select [b2].Select Range("b2").Formula = "=yasbul(e1,e2,1)*(-1)" [b2].Select Selection.AutoFill Destination:=[b2:b51], Type:=xlFillDefault [b2].Select End Sub Sub formulden_degere() Application.ScreenUpdating = False Sheets(ComboBox2.Value).Select Range("B2:B51").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("B2").Select Application.CutCopyMode = False Range("B2").Select Application.ScreenUpdating = True End Sub

formülle baş harfi büyük küçük öğrenme

ID : 922
ISLEM : formülle baş harfi büyük küçük öğrenme
MAKRO KODU : küçük

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

ID : 923
ISLEM : formülleri değere dönüştürme
MAKRO KODU : Sub a() ‘1.yol [B1].Value = [A1].Value End Sub Sub cokcokolsun() ‘2.yol [B1:B100].Value = [A1].Value End Sub Sub stepkopyala() ‘3.yol 1 er sütun atlayarak Dim x As Integer For x = 2 To 256 Step 2 Cells(1, x).Value = Cells(1, x).Offset(0, -1).Value Next x End Sub

formülleri sayıya çevirme

ID : 924
ISLEM : formülleri sayıya çevirme
MAKRO KODU : Sub Form2val() For Each c in Selection.Cells c.formula=c.value Next c End Sub

formülleri sayiya çevirir

ID : 925
ISLEM : formülleri sayiya çevirir
MAKRO KODU : FORMÜLLERİ SAYIYA ÇEVİRİR Sub Form2val() For Each c in Selection.Cells c.formula=c.value Next c End Sub

formülleri yeni sayfada listeler

ID : 926
ISLEM : formülleri yeni sayfada listeler
MAKRO KODU : Option Explicit Public Sub ListFormulasInWorkbook() ' by J.E. McGimpsey ' revised 04 July 2003 by Tom Ogilvy to add ' sheets when reaching ROWLIM formulas Const SHEETNAME As String = "Formulas in *" Const ALLFORMULAS As Integer = _ xlNumbers + xlTextValues + xlLogical + xlErrors Const ROWLIM As Long = 65500 Dim formulaSht As Worksheet Dim destRng As Range Dim cell As Range Dim wkSht As Worksheet Dim formulaRng As Range Dim shCnt As Long Dim oldScreenUpdating As Boolean With Application oldScreenUpdating = .ScreenUpdating .ScreenUpdating = False End With shCnt = 0 ListFormulasAddSheet formulaSht, shCnt ' list formulas on each sheet Set destRng = formulaSht.Range("A4") For Each wkSht In ActiveWorkbook.Worksheets If Not wkSht.Name Like SHEETNAME Then Application.StatusBar = wkSht.Name destRng.Value = wkSht.Name Set destRng = destRng.Offset(1, 0) On Error Resume Next Set formulaRng = wkSht.Cells.SpecialCells( _ xlCellTypeFormulas, ALLFORMULAS) On Error GoTo 0 If formulaRng Is Nothing Then destRng.Offset(0, 1).Value = "None" Set destRng = destRng.Offset(1, 0) Else For Each cell In formulaRng With destRng .Offset(0, 1) = cell.Address(0, 0) .Offset(0, 2) = "'" & cell.Formula .Offset(0, 3) = cell.Value End With Set destRng = destRng.Offset(1, 0) If destRng.row > ROWLIM Then ListFormulasAddSheet formulaSht, shCnt Set destRng = formulaSht.Range("A5") destRng.Offset(-1, 0).Value = wkSht.Name End If Next cell Set formulaRng = Nothing End If With destRng.Resize(1, 4).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With Set destRng = destRng.Offset(1, 0) If destRng.row > ROWLIM Then ListFormulasAddSheet formulaSht, shCnt Set destRng = formulaSht.Range("A5") destRng.Offset(-1, 0).Value = wkSht.Name End If End If Next wkSht With Application .StatusBar = False .ScreenUpdating = oldScreenUpdating End With End Sub Private Sub ListFormulasAddSheet( _ formulaSht As Worksheet, shtCnt As Long) Const SHEETNAME As String = "Formulas in " Const SHEETTITLE As String = "Formulas in $ as of " Const DATEFORMAT As String = "dd MMM yyyy hh:mm" Dim shtName As String With ActiveWorkbook ' Delete existing sheet and create new one shtCnt = shtCnt + 1 shtName = Left(SHEETNAME & .Name, 28) If shtCnt > 1 Then _ shtName = shtName & "_" & shtCnt On Error Resume Next Application.DisplayAlerts = False .Worksheets(shtName).Delete Application.DisplayAlerts = True On Error GoTo 0 Set formulaSht = .Worksheets.Add( _ after:=Sheets(Sheets.Count)) End With With formulaSht ' Format headers .Name = shtName .Columns(1).ColumnWidth = 15 .Columns(2).ColumnWidth = 8 .Columns(3).ColumnWidth = 60 .Columns(4).ColumnWidth = 40 With .Range("C:D") .Font.Size = 9 .HorizontalAlignment = xlLeft .EntireColumn.WrapText = True End With With .Range("A1") .Value = Application.Substitute(SHEETTITLE, "$", _ ActiveWorkbook.Name) & Format(Now, DATEFORMAT) With .Font .Bold = True .ColorIndex = 5 .Size = 14 End With End With With .Range("A3").Resize(1, 4) .Value = Array("Sheet", "Address", "Formula", "Value") With .Font .ColorIndex = 13 .Bold = True .Size = 12 End With .HorizontalAlignment = xlCenter With .Borders(xlEdgeBottom) .LineStyle = xlDouble .Weight = xlThick .ColorIndex = 5 End With End With End With End Sub

formüllerin gizlenmesi

ID : 927
ISLEM : formüllerin gizlenmesi
MAKRO KODU : Sub Auto_Open() Cells.Select 'Range("formüllü hücreler").Select Selection.Locked = True Selection.FormulaHidden = True Range("a1").Select Sheets("Sayfa1").Protect Password:="123" End Sub '***********Dosyayı kapatırken ise*********************** Sub Auto_Close() Sheets("Sayfa1").Unprotect Password:="123" Cells.Select 'Range("formüllü hücreler").Select Selection.Locked = False Selection.FormulaHidden = False Range("a1").Select End Sub

formüllerin makro dili (ingilizcesi)

ID : 928
ISLEM : formüllerin makro dili (ingilizcesi)
MAKRO KODU : Sub AddressFormulasMsgBox() For Each Item In Selection If Mid(Item.Formula, 1, 1) = "=" Then MsgBox "The formula in " & Item.Address(rowAbsolute:=False, _ columnAbsolute:=False) & " is: " & Item.Formula, vbInformation End If Next End Sub

formüllü hücre renkli

ID : 929
ISLEM : formüllü hücre renkli
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.HasFormula Then With Selection.Interior .ColorIndex = 39 End With ActiveCell.Offset(0, 1).Select End If End Sub

formüllü hücre silmeyi engelleme

ID : 930
ISLEM : formüllü hücre silmeyi engelleme
MAKRO KODU : *********Sayfanın kod bölümüne*************************** Option Explicit Private Sub Worksheet_Deactivate() Application.OnKey "{del}" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula Then Application.OnKey "{del}", "mesaj" Else Application.OnKey "{del}" End If End Sub '*********ThisWorbook kod bölümüne************************* Option Explicit '*********bunu da modüle ********************************* Sub mesaj() MsgBox " Formül silmek yasak kardeşim" End Sub

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