Excel'le Adım Adım Program Yazma

KİTABI KAYDET PENCEREYİ KAPAT A1'İ SEÇ

Private Sub CommandButton6_Click()
   ActiveWorkbook.Save
    ActiveWindow.Close
    Range("A1").Select
End Sub

Sayfa Gizle
Sub auto_open()
Worksheets("Sayfa1").Visible = False
End Sub

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

1.SAYFA HARİÇ TÜM SAYFALARI GİZLE

Sub xlVeryHidden_All_Sheets()
On Error Resume Next
Dim sh As Worksheet
For Each sh In Worksheets
    sh.Visible = xlVeryHidden
Next
End Sub

FORMDAN COMBOBOX KUTUSUNA KOMUT BU KOMUT İSİMLERİ SIRAYA SOKAR MODÜLE YAZILAN KOMUT İLE BİRLİKTE.

Private Sub UserForm_Initialize()
MyForm = Me.Name
ComboBox1.RowSource = "sayfa1!b1:b1000"
OrganizeComboBox
End Sub
BU BÖLÜM MODÜL KISMINA YAZILACAK.
Dim MyForm As Variant
Option Base 1
'
Sub OrganizeComboBox()
Dim noData, i, j, k, m As Integer
Dim MyComboArray()
Dim MyRevizedComboArray()
Dim MyData As Range
Dim SortedColl As New Collection
Dim Swap1, Swap2 As Variant
'
For Each MyControl In UserForms(MyForm).Controls
'
i = 0
j = 0
k = 0
'
If TypeName(MyControl) = "ComboBox" Then
noData = MyControl.ListCount
ReDim MyComboArray(noData)
For Each MyData In Range(MyControl.RowSource)
i = i + 1
MyComboArray(i) = MyData
Next
For m = 1 To UBound(MyComboArray)
If Not WorksheetFunction.IsNumber(MyComboArray(m)) Then
MyComboArray(m) = UCase(MyComboArray(m))
MyComboArray(m) = Replace(MyComboArray(m), "Ç", "Ç")
MyComboArray(m) = Replace(MyComboArray(m), "İ", "İ")
MyComboArray(m) = Replace(MyComboArray(m), "Ğ", "Ğ")
MyComboArray(m) = Replace(MyComboArray(m), "Ş", "Ş")
MyComboArray(m) = Replace(MyComboArray(m), "Ü", "Ü")
MyComboArray(m) = Replace(MyComboArray(m), "Ö", "Ö")
End If
Next
For i = 1 To UBound(MyComboArray)
For j = i + 1 To UBound(MyComboArray) - 1
If MyComboArray(i) = MyComboArray(j) Then
MyComboArray(i) = ""
End If
Next
Next
'
MyControl.RowSource = ""
'
For i = 1 To UBound(MyComboArray)
If MyComboArray(i) <> "" Then
k = k + 1
ReDim Preserve MyRevizedComboArray(k)
MyRevizedComboArray(k) = MyComboArray(i)
End If
Next
'
i = 0
j = 0
For i = 1 To UBound(MyRevizedComboArray)
SortedColl.Add MyRevizedComboArray(i)
Next
'
'On Error Resume Next
'For i = 1 To UBound(MyRevizedComboArray)
'MyRevizedComboArray(i) = WorksheetFunction.Small(MyRevizedComboArray, i)
'Next

For i = 1 To SortedColl.Count - 1
For j = i + 1 To SortedColl.Count
If SortedColl(i) > SortedColl(j) Then
Swap1 = SortedColl(i)
Swap2 = SortedColl(j)
SortedColl.Add Swap1, before:=j
SortedColl.Add Swap2, before:=i
SortedColl.Remove i + 1
SortedColl.Remove j + 1
End If
Next j
Next i
'
For i = 1 To SortedColl.Count
MyControl.AddItem SortedColl(i)
Next
'
For i = SortedColl.Count To 1 Step -1
SortedColl.Remove i
Next
'
End If
Erase MyComboArray
Erase MyRevizedComboArray
'
Next
End Sub

Metni büyük harfli yapmak için şu makroyu kullanın:

Sub BuyukHarf()
For Each c In Selection.Cells
c.Value=Ucase$(c.Value)
Next c
End Sub

Metni küçük harf yapmak içinse şu makroyu kullanın:

Sub KucukHarf()
For Each c In Selection.Cells
c.Value=Lcase$(c.Value)
Next c
End Sub

VERİLEN HÜCRE ÖLÇÜTÜNE GÖRE SAYFAYA YAZILANLARI BÜYÜK HARFE ÇEVİRİR.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaBereich As Range, RaZelle As Range
    Application.EnableEvents = False
    Set RaBereich = Range("a1:ı1000")
    Application.EnableEvents = False
    For Each RaZelle In Range(Target.Address)
        If Not Intersect(RaZelle, RaBereich) Is Nothing Then
            RaZelle.Value = UCase(RaZelle.Value)
        End If
    Next RaZelle
    Application.EnableEvents = True
    Set RaBereich = Nothing
End Sub

VERİLEN HÜCRE ÖLÇÜTÜNE GÖRE SAYFAYA YAZILANLARIN BAŞ HARFİNİ BÜYÜK HARFE ÇEVİRİR.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaBereich As Range, RaZelle As Range
    Application.EnableEvents = False
    Set RaBereich = Range("a1:ı1000")
    Application.EnableEvents = False
    For Each RaZelle In Range(Target.Address)
        If Not Intersect(RaZelle, RaBereich) Is Nothing Then
            If RaZelle <> "" Then
                RaZelle.Value = UCase(Mid(RaZelle.Value, 1, 1)) _
                    & LCase(Mid(RaZelle.Value, 2, Len(RaZelle.Value) - 1))
            End If
        End If
    Next RaZelle
    Application.EnableEvents = True
    Set RaBereich = Nothing
End Sub

Programınızı açtığınızda size merhaba demesini istemezmisiniz işte kodlar

Sub Auto_Open()
Msgbox "MERHABA"
End Sub

Çalışma Kitabını Kapat  Ve  Kaydet

Sub kayıt()
ActiveWorkbook.Close
End Sub
Çalışma Kitabını Kaydet
Sub kayıt()
ActiveWorkbook.Save
End Sub

HÜCRE SÜRÜKLENMESİNİ ENGELLE

Sub SuruklemeyiEngelle()
    Application.CellDragAndDrop = False
End Sub
HÜCRE SÜRÜKLENMESİNİ AKTİF YAP
Sub Auto_Close()
    Application.CellDragAndDrop = True
End Sub

Boş olan Satırları Gizle

Sub satirgizle()
Dim i As Integer
For i = 1 To 15
If Sheets("Sayfa1").Cells(i, 1).Value <> "" Then
Rows(i).Hidden = False
Else
Sheets("Sayfa1").Rows(i).Hidden = True
End If
Next i
End Sub

Boş olan Satırları Gizle

Sub satirgizle()
Dim i As Integer
For i = 1 To 15
If Sheets("Sayfa1").Cells(i, 1).Value <> "" Then
Rows(i).Hidden = False
Else
Sheets("Sayfa1").Rows(i).Hidden = True
End If
Next i
End Sub

A Sütunundaki Boş Satırları Gizler

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim i As Integer
For i = 1 To 300 '1 satır ile 300. satır arası
If IsEmpty(Cells(i, 1)) Then '1. Satır 1. Sütun yani A1 hücresi
Rows(i).Hidden = True
End If
Next i
Application.ScreenUpdating = True
End Sub

C  Sütunundaki Boş Satırları Gizler

Sub bidahabossatgizle()
For i = 6 To 160
If Range("c" & i) = "" Then _
Range("c" & i).EntireRow.Hidden = True
Next

SAYFA KORUMA MENÜSÜ ÇAĞIR

Sub BlattSchutzEin()
Application.Dialogs(xlDialogProtectDocument).Show
End Sub
SAYFA KORUMASINI KALDIR MENÜSÜ

Sub BlattSchutzAus()
ActiveSheet.Unprotect
End Sub