Makro Kod Listesi

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

ID : 1141
ISLEM : hücreye değer girince picture görünmesi
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) <> "A1" Then Exit Sub If Target <> "" Then Image1.Picture = LoadPicture("C:\1.jpg") Else Image1.Picture = LoadPicture("") End If End Sub

ID : 1142
ISLEM : hücreye değer yazınca başka hücreye gitme
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Range("A1").Value = 1 Then Range("D54").Select ElseIf Range("A1").Value = 2 Then Range("C12").Select ElseIf Range("A1").Value = 3 Then Range("H45").Select End If End Sub

ID : 1143
ISLEM : hücreye değer yazınca toplama, başka hücreye yazma
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(False, False) = "A1" And Not Target = "" Then Range("C1") = Range("A1") + Range("B1") End If End Sub

ID : 1144
ISLEM : hücreye formül atama
MAKRO KODU : Range(“C3”).Formula =”=D3+D4” - ->Formul atanır.

ID : 1145
ISLEM : hücreye formül ekleme
MAKRO KODU : Sub ModifFormule() Application.SendKeys "{f2}" 'Envoie la touche F2 For I = 1 To 10 'Boucle pour mettre le curseur à gauche Application.SendKeys "{f3}" Next I Application.SendKeys "{f4}" 'Pour écrire à droite du signe = Application.SendKeys "{P}{r}{i}{x}{.}{x}{l}{s}{!}" Application.SendKeys "{Enter}" 'Valide la formule End Sub

ID : 1146
ISLEM : hücreye formül girme, kitaba link
MAKRO KODU : Sub einlesen() datnam = InputBox("Geben Sie den Dateinamen ein (ohne Endung):") Range("B4").Formula = "=[" & datnam & ".xls]Tabelle1!A1" Range("A4") = "Wert aus der Datei " & datnam & ".xls :" End Sub

ID : 1147
ISLEM : hücreye formül girmek
MAKRO KODU : Sub EnterFormula() Worksheets("Sayfa1").Range("D6").Formula = "=SUM(D2:D5)" End Sub

ID : 1148
ISLEM : hücreye formül yazdirirken referans çeşitleri
MAKRO KODU : Birçok yolu var da, bir tanesi : Kod: ilkhucre = ActiveCell.Offset(0, 1).Address sonhucre = ActiveCell.Offset(0, 2).Address ActiveCell.Offset(0, 1).Formula = "=Sum(" & ilkhucre & ":" & sonhucre & ")" _________________ Burası Excel vadisi .... _________________ Teşekkürler raider.. bu syntaxte hata yaptım diye 10 çeşidini denedim ama sen yazınca emin oldum ve başka yerde olduğunu anladım hatanın.. Sorarken address'leri yazmamışım ama oda değil koddaki hata.. ilk satırda ilkhucre'yi hücre referansı olarak alıp sonraki satırda onu toplamda kullanmışım.. Tabi ilkhucre, birincihucre, enilkhucre diye isimler verince bana müstehaktır. Kod: ilkhucre = ActiveCell.Offset(SatirSayisi + 2, 1) .address sonhucre = ActiveCell.Offset(ilkhucre + KacFatura, 1).address

ID : 1149
ISLEM : hücreye gelindiğinde makro çalıştır
MAKRO KODU : A1:A10 arasi hücrelerinin uzerine gelindiginde makro calisin. Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("a1:a10")) Is Nothing Then Exit Sub makroadi() End Sub

ID : 1150
ISLEM : hücreye girdiğim sayiya göre şeklin eninin büyüyüp küçülmesini istiyorum.
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Shapes("Rectangle 1").Height = Range("A1") / 10 * 3.2 * 72 / 2.54 End Sub

ID : 1151
ISLEM : hücreye girilen sayının açıklamada (123,00) şeklinde yazılması
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'Von Thomas Ramel Dim rngZelle As Range Dim rngNachfolger As Range On Error Resume Next For Each rngZelle In Target rngZelle.NoteText Format(rngZelle.Value, "#,##0.00") For Each rngNachfolger In rngZelle.Dependents rngNachfolger.NoteText Format(rngNachfolger.Value, "#,##0.00") Next rngNachfolger Next rngZelle End Sub

ID : 1152
ISLEM : hücreye git
MAKRO KODU : Sub GetRange() Dim Rng As Range On Error Resume Next Set Rng = Application.InputBox(prompt:="Enter range", Type:=8) If Rng Is Nothing Then MsgBox "Operation Cancelled" Else Rng.Select End If End Sub

ID : 1153
ISLEM : hücreye gitme
MAKRO KODU : Sub SelectCell() Application.GoTo Reference:=ActiveSheet.Range("F1"), Scroll:=True End Sub

ID : 1154
ISLEM : hücreye inputbox ile veri girme
MAKRO KODU : Sub range_input() Dim pir As String pir = InputBox("Formülde Girebilirsiniz", "Hücreye yazılacak metni yazınız") Range("A1").Value = pir End Sub

ID : 1155
ISLEM : hücreye o anki saati , zamanı eklemek
MAKRO KODU : Option Explicit Sub setKey() Application.OnKey "+^:", "EnterTime" End Sub Sub resetKey() Application.OnKey "+^:" End Sub Sub EnterTime() With ActiveCell .Value = Time() .NumberFormat = "hh:mm:ss" End With End Sub

ID : 1156
ISLEM : hücreye sayı veya değer girme
MAKRO KODU : Range (“B5”).Value=36 - -> B5 hücresine 36 atanır.

ID : 1157
ISLEM : hücreye silinecek veri aralığını yaz silsin (sayfa1de a2,b2ye yaz,sayfa1 ve sayfa2den siler)
MAKRO KODU : Sub SİL() Sheets("Sayfa1").Select Set ALAN1 = [A2] Set ALAN2 = [B2] If ALAN1 <> "" Then Sheets("Sayfa1").Range(ALAN1).ClearContents If ALAN2 <> "" Then Sheets("Sayfa2").Range(ALAN2).ClearContents Sheets("Sayfa1").Select MsgBox "İŞLEM TAMAMLANMIŞTIR.", vbInformation End Sub

ID : 1158
ISLEM : hücreye şifre vermek
MAKRO KODU : Örnek kodu biraz değiştirdim. Aşağıdaki şekilde deneyin. Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, [a1:b7]) Is Nothing Or Not Intersect(Target, [c18:c21]) Is Nothing Then If sifre = False Then c = InputBox("Şifre yazınız. (şifre : 123 )", "Onay şifresi") If c <> 123 Then Application.Undo Else sifre = True End If End If End If Application.EnableEvents = True End Sub

ID : 1159
ISLEM : hücreye tıklayınca otomatik olarak sütunun istenilen genişlikte açılması
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Zelle = Target.Address Select Case Zelle Case "$D$2" Range("$D$2").ColumnWidth = 52 'entspricht 369 Pixel Case Else Range("$D$2").ColumnWidth = 16.43 'entspricht 120 Pixel End Select End Sub

ID : 1160
ISLEM : hücreye tıklayınca otomatik olarak sütunun istenilen genişlikte açılması 2
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range Set rng = Columns("B:B") If Not (Intersect(Target, rng) Is Nothing) Then rng.ColumnWidth = 30 Else rng.ColumnWidth = 10.71 End If End Sub

ID : 1161
ISLEM : hücreye tıklayınca userform açılsın
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address(False, False) = "A1" Then UserForm1.Show End Sub

ID : 1162
ISLEM : hücreye veri girince uyarı alma
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$3" Then MsgBox "Changed It!" End If End Sub

ID : 1163
ISLEM : hücreye yazı yaz ve fontunu kalın yap
MAKRO KODU : Sub Labels() With Worksheets("Sheet1") .Range("A1") = "Name" .Range("B1") = "Address" .Range("A1:B1").Font.Bold = True End With End Sub

ID : 1164
ISLEM : hücreye yazı yazmak
MAKRO KODU : Sub Macro1() Sheets("Sheet1").Select Range("A1").Select ActiveCell.FormulaR1C1 = "Name" Range("B1").Select ActiveCell.FormulaR1C1 = "Address" Range("A1:B1").Select Selection.Font.Bold = True End Sub

ID : 1165
ISLEM : hücreyi basamak şeklinde renklendirme
MAKRO KODU : Sub UniondePlage() Dim plg1, plg2, ToutePlage As Range Set plg1 = Sheets("Feuil1").Range("A1:A10") Set plg2 = Sheets("Feuil1").Range("B10:B20") Set ToutePlage = Union(plg1, plg2) ToutePlage.Interior.ColorIndex = 5 End Sub

ID : 1166
ISLEM : hücreyi göster virgülden sonra rakam eklesin
MAKRO KODU : Sub pourcentage() Dim mycell, myvaleur, pourcent pourcent = InputBox("Quel pourcentage appliquer?") If IsNumeric(pourcent) Then For Each mycell In Application.Selection.Cells myvaleur = mycell.Value If IsNumeric(myvaleur) Then 'teste si la cellule n'est pas vide ou contient une formule If Not (IsEmpty(myvaleur) Or mycell.HasFormula) Then mycell.Value = myvaleur * (pourcent / 100 + 1) End If End If Next mycell End If End Sub

ID : 1167
ISLEM : hücreyi metin biçiminde biçimlendirmek:
MAKRO KODU : Range("A1").NumberFormat = "@"

ID : 1168
ISLEM : hücreyi para birimi yapmak
MAKRO KODU : Sub Makro1() Range("A2,B4,E6,F2:F21").Select Range("F2").Activate Selection.NumberFormat = "[$$-409]#,##0.00" Range("A1").Activate End Sub

ID : 1169
ISLEM : hüreler farklı olursa uyarı mesajı
MAKRO KODU : Private Sub Worksheet_Change(ByVal Target As Range) If [a10].Value <> [c10].Value Then MsgBox ("Girdiğiniz rakamlar farklı") End Sub

ID : 1170
ISLEM : ı1:i13 hücrelerinde yazılı yazılı olan veriler 0'a eşit değilse 0 yapar çevirir
MAKRO KODU : Sub ResetTest3() For Each amount In Range("I1:I13") If amount.Value <> 0 Then amount.Value = 0 End If Next amount End Sub