Excel'le Adım Adım Program Yazma

Ağdaki excel dosyasını açma

Workbooks.Open Filename:="\\can\c\Belgelerim\hesap.xls"

Aktif bulunan araç çubuklarını sayar, sıralar

Sub DisplayToolBarNumber()
Dim i As Integer
    i = 0
    For i = 1 To Application.Toolbars.Count
        MsgBox Toolbars(i).Name, , "Toolbar " & _
            i & " of " & Application.Toolbars.Count
    Next i
End Sub

Aktif çalışma kitabı hariç tüm kitapları kapat

Sub CloseAllButActive()
  'based on Tom Ogilvy's postings
  Dim wkbk As Workbook
  For Each wkbk In Application.Workbooks
    If wkbk.Name <> ActiveWorkbook.Name Then
      If Windows(wkbk.Name).Visible = True Then
        'MsgBox wkbk.Name & " " & Window

Aktif Çalışma kitabının adını aktif hücreye yazdırır

Sub kitapismi()
ActiveCell.Value = ActiveWorkbook.FullName
End Sub

Aktif çalışma kitabının kaydedilmesi

ActiveWorkbook.Save

Aktif hücre bildirimi

Sub GetColumnLetter()
Dim MyColumn As String, Here As String   
'// Get the address of the active cell in the current selection.
Const msg = "The column letters @ "
Here = ActiveCell.Address
'// Note Address format is $<columnletter>$<rownumber>,
'// so drop the first character and the characters
'// after the column letter(s).
MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
'// Show the result
MsgBox msg & Here & ":= " & MyColumn
End Sub

Aktif hücre boş ve 0 değilse boş değilse 0 yapar

Sub ResetTest4()
For Each n In ActiveSheet.UsedRange
    If n.Value <> 0 Then
        n.Value = 0
    End If
Next n
End Sub

Aktif hücre renklensin

Kod çalışma sayfasına

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Static EskiHucre As Range
  If Target.Interior.ColorIndex <> xlColorIndexNone Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
    Exit Sub
  ElseIf Not EskiHucre Is Nothing Then
    EskiHucre.Interior.ColorIndex = xlColorIndexNone
  End If
  Target.Interior.ColorIndex = 6
  Set EskiHucre = Target
End Sub

Aktif hücre veya seçilen hücrelere ad tanımlar

Sub AddName4()
Selection.Name = "MyRange4"
End Sub

Aktif hücre veya seçilen hücrelere ad tanımlar "my range2"

Sub AddName2()
ActiveSheet.Names.Add Name:="MyRange2", RefersTo:="=" & Selection.Address()
End Sub

Aktif hücrede çift tıkla üst satırların alttoplam formülünü yazsın


Private Sub Worksheet_BeforeDoubleClick(ByVal _
     Target As Range, Cancel As Boolean)
   Cancel = True
   Range(Target.Offset(-1, 0).End(xlUp), Target).Select
   Target.Formula = "=SUBTOTAL(9," _
     & Selection(1).Address(0, 0) & ":" _
     & Selection(Selection.Count - 1).Address(0, 0) & ")"
   Target.Activate
End Sub

Aktif hücrede daha küçük değer girdirmez

Dim eski
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value < eski Then
    MsgBox "Mevcut değerden daha küçük bir değer giremezsiniz!", vbCritical
    Target.Value = eski
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
eski = Target.Value
End Sub

Aktif hücrede formül varsa adresini ve formül cinsini verir

Sub ListFormulas()
    Dim counter As Integer
    Dim i As Variant
    Dim sourcerange As Range
    Dim destrange As Range
    Set sourcerange = Selection.SpecialCells(xlFormulas)
    Set destrange = Range("M1")
    destrange.CurrentRegion.Clear Contents
    destrange.Value = "Address"
    destrange.Offset(0, 1).Value = "Formula"
        If Selection.Count > 1 Then
            For Each i In sourcerange
                counter = counter + 1
                destrange.Offset(counter, 0).Value = i.Address
                destrange.Offset(counter, 1).Value = "'" & i.Formula
            Next
        ElseIf Selection.Count = 1 And Left(Selection.Formula, 1) = "=" Then
                destrange.Offset(1, 0).Value = Selection.Address
                destrange.Offset(1, 1).Value = "'" & Selection.Formula
        Else
                MsgBox "This cell does not contain a formula"
        End If
    destrange.CurrentRegion.Entir eColumn.AutoFit
End Sub

Aktif hücredeki metni harflere (sütunlara 3 er karaktere bölerek ayırır)

Sub AA_Parse_3Letter()
'converts a string in a single cell into tripletts of characters in consecutive cells, assuming one separation character
'e.g. Amino acid sequences in 3-letter-code or nucleotide tripletts
'you can select a range of cells within the

Aktif hücredeki metni harflere (sütunlara ayırır)

Sub AA_Parse()
'converts a text string in a single cell into individual characters in consecutive cells
'you can select a range of cells within the same column
'do not select more than one column, cells to the right of this column will be overwritten
If S