Excel'le Adım Adım Program Yazma

Aç penceresi

Sub Dialog_28()
Application.Dialogs(xlDialogFindFile).Show
End Sub

Açık olan tüm kitapların kapatılması


Workbooks.Close

Açıklama ekleme


Sub aciklama_ekler()
Dim Açıklama_Ekleme As Comment
Dim strText As String
  strText = Application.InputBox("Eklenecek olan mesajı aşağıya yazınız.", _
    "Açıklama_Ekleme", "Açıklama Ekler", , , , 2)
  If Application.ExecuteExcel4Macr o("Get.Cell(46)") = True Then
    ActiveCell.Comment.Delete
  End If
  ActiveCell.AddComment
  Set Açıklama_Ekleme = ActiveCell.Comment
    With Açıklama_Ekleme
      .Text Text:=strText
      With .Shape.TextFrame.Characters.F ont
        .Name = "Arial"
        .Size = 10
        .Bold = False
      End With
    End With
End Sub

Açıklama formunu kapatır

Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

Açıklama formunun adresi


Private Sub CommandButton1_Click()
Load UserForm1
UserForm1.Show
End Sub

Açıklama silme


Sub aciklama_sil()
  If Application.ExecuteExcel4Macr o("Get.Cell(46)") = True Then
    ActiveCell.Comment.Delete
  End If
End Sub

Sub aciklama_sil()
  If Not ActiveCell.Comment Is Nothing Then
    ActiveCell.Comment.Delete
  End If
End Sub

Açıklamadaki yazı genişliğini otomatik sığdırma

Sub auto_comment()
     Dim commentrange As Range
Application.DisplayCommentInd icator = xlCommentAndIndicator
    For Each commentrange In ActiveSheet.Cells.SpecialCell s(1)
       commentrange.Comment.Shape.Se lect True
    Selection.AutoSize = True
    'Selection.ShapeRange.Width = 150
    'Selection.ShapeRange.Height = 100
    Next
Application.DisplayCommentInd icator = xlCommentIndicatorOnly
End Sub

Açıklamanın yazı puntosu ve kalınlığı


Sub Kommentar_Font()
    Dim Cell As Range
    For Each Cell In Cells.SpecialCells(xlCellTypeComments)
        With Cell.Comment.Shape.TextFrame. Characters.Font
            .Size = 10
            .Bold = True
        End With
    Next
End Sub

Açıklamaya resim eklemek


Option Explicit

Const ImgFileFormat = "Image Files (*.bmp;*.gif;*.tif;*.jpg;*.jpeg)," & _
    "*bmp;*gif;*.tif;*.jpg;*.jpeg"

Sub AddPicturesToComments()
Dim HasCom
Dim Pict As String
Dim Ans As Integer

Set HasCom = ActiveCell.Comment
If Not HasCom Is Nothing Then ActiveCell.Comment.Delete
Set HasCom = Nothing

GetPict:
Pict = Application.GetOpenFilename(ImgFileFormat)
'Note you can load in, almost any file format
If Pict = "False" Then End

Ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?")
If Ans = vbNo Then GoTo GetPict

With ActiveCell
    .AddComment
    .Comment.Visible = False
    .Comment.Shape.Fill.Transpare ncy = 0#
    .Comment.Shape.Fill.UserPictu re Pict
End With
End Sub

Açılan kitabın ekranını büyütür.

Sub auto_open()
    Application.WindowState = xlMaximized
    ActiveWindow.WindowState = xlMaximized
    Application.MoveAfterReturn = False
    With ThisWorkbook.Worksheets("Buch")
      .Range("J2").Value = Month(Date)
      .Range("K2").Value = Year(Date)
      .OnEntry = "Fahrtenbuch"
   End With
End Sub

Açılış makrosu (istenilen sayfa)


Private Sub Workbook_Open()
ThisWorkbook.Worksheets("Sayfa1").Activate
End Sub

Açılış makrosu(aktif pencerede mesaj verir.)


Sub Auto_Open()
Sheets("Bir").Select
   ActiveWindow.WindowState = xlMaximized
   Range("C2").Select
    ActiveWindow.DisplayWorkbookT abs = False
    ActiveWindow.WindowState = xlMaximized
    Application.CommandBars("Full Screen").Visible = False
    Application.CommandBars("Formatting").Visible = False
    Application.CommandBars("Standard").Visible = False

ActiveCell.Select   'mesaj ver yazdır makrosunu kullanarak
    ilan
Application.Caption = "mahmut_bayram@mynet.com"
    ActiveWindow.Caption = "0505-778 47 69"
End Sub

Açılış ta prosedür (makro) çalıştırma


Sub Auto_Open()
ActiveSheet.OnEntry = "Action"
End Sub
 
Sub Auto_Close()
ActiveSheet.OnEntry = ""
End Sub

Açılışta aktif pencerenin minimize olması


Option Explicit
Private Sub Workbook_Open()
ActiveWindow.WindowState = xlMinimized
UsfIntro.Show
End Sub

'eski haline gelmesi
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWindow.WindowState = xlNormal
End Sub

Açılışta ayrı menü olarak araç düğmelerinden bir kaçını getirme

Option Explicit

Private Sub Workbook_Open()
    On Error Resume Next
    With Application.CommandBars("TestCB")
        .Position = msoBarFloating
        .Left = 200
        .Top = 200
        .Visible = True
    End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.CommandBars("TestCB").Delete
End Sub

Private Sub Workbook_Activate()
    On Error Resume Next
    Application.CommandBars("TestCB").Visible = True
End Sub

Private Sub Workbook_Deactivate()
    On Error Resume Next
    Application.CommandBars("TestCB").Visible = False
End Sub