Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Şubat 2004 Cuma

Preview Windows MetaFile (AutoCat Files) On Excel


 
'UserForm1
 
'A) Windows XP® Office 2003® Normal Referance List
    'Visual Basic For Aplication
    'Microsoft Forms 2.0 Object Library
    'Microsoft Excel 11.0 Object Library
    'OLE Automation
    'Microsoft Office 11.0 Object Library
    'Microsoft Office Web Components 11.0
'B) UserForm1 E Eklenen Araçlar (Add Tools)
    'Frame1
    'Frame1\Image1, Label1, Label2
    'CommandButton1,Label4, Label5, Label6
    'Frame2
    'Frame2\Frame3
'C) If you drag the mouse over the picture (Frame2); appears Frame3
Option Explicit
Dim Yol
Dim Mercek As Double, Büyütme As Double
Dim ÇerçeveDüzenleme As New Class1
Private Sub UserForm_Initialize()
    On Error Resume Next
    Me.Caption = "[PBİD ®] Preview Windows MetaFile (Frome AutoCat Files) On Excel"
    Mercek = 4 '%400
    Büyütme = 0.4
    Call EkranDüzenle
    Application.Visible = False
    Application.VBE.MainWindow.Visible = False
    Set ÇerçeveDüzenleme.LogoYerleştir = Me
    Set ÇerçeveDüzenleme.Form1 = Me
End Sub
Private Sub UserForm_Activate()

    On Error Resume Next
    With Me
        .Top = (Application.Height - .Height) / 2
        .Left = (Application.Width - .Width) / 2
    End With
End Sub
Private Sub UserForm_Resize()

    On Error Resume Next
    With Me
        .Top = (Application.Height - .Height) / 2
        .Left = (Application.Width - .Width) / 2
    End With
    Call EkranDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    Application.Visible = True
    End
End Sub
Private Sub CommandButton1_Click()

    On Error GoTo Hata:
    Yol = Application.GetOpenFilename("Windows MetaFile Dosyaları(*.wmf;*.All),*.wmf;*.All", , "[PBİD®] Sayfaya eklenecek AutoCat Çizim Örneği seçimi...", , False)
    If Yol = False Then Exit Sub
    Label3.Caption = " Windows MetaFile: " & VBA.Trim(Yol)
    With Frame2
        .Picture = LoadPicture(VBA.Trim(Yol))
        .Zoom = 100
    End With
    Exit Sub
Hata:
End Sub
Private Sub Frame2_Zoom(Percent As Integer)

    On Error Resume Next
    Select Case Percent
    Case 10 To 400
        Frame2.ScrollWidth = VBA.Round(Frame2.Width * Percent / 100, 0)
        Frame2.ScrollHeight = VBA.Round(Frame2.Height * Percent / 100, 0)
    End Select
End Sub
Private Sub Frame2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) 'If you drag the mouse over the picture appears çerçeve3
    On Error Resume Next
    If Button = 1 Then
        Frame2.MousePointer = fmMousePointerCross
        With Frame3
            .BackColor = vbBlack
            .Width = Frame2.Width * Büyütme
            .Height = Frame2.Height * Büyütme
            .Left = Frame2.Width - 12 - .Width - Frame2.Left
            .Top = 6
            .SpecialEffect = 0
            .BorderStyle = 1
            .BorderColor = vbBlue
            .Picture = Frame2.Picture
            .PictureSizeMode = fmPictureSizeModeStretch
            .ScrollHeight = Frame2.ScrollHeight / (Frame2.Zoom / 100) * Mercek
            .ScrollWidth = Frame2.ScrollWidth / (Frame2.Zoom / 100) * Mercek
            .Zoom = 400
            .ScrollLeft = x / (Frame2.Zoom / 100) * Mercek
            .ScrollTop = y / (Frame2.Zoom / 100) * Mercek
            .Visible = True
        End With
        Label4.Caption = VBA.Round(x, 0)
        Label5.Caption = VBA.Round(y, 0)
        Label6.Caption = VBA.Format(Frame3.Zoom, "%#")
        DoEvents
    Else
        Frame2.MousePointer = fmMousePointerCross
        Frame3.Visible = False
        Label4.Caption = VBA.Round(x, 0)
        Label5.Caption = VBA.Round(y, 0)
        Label6.Caption = VBA.Format(Frame2.Zoom, "%#")
        DoEvents
    End If
End Sub
Sub Kapat()

    Set ÇerçeveDüzenleme.FormYokol = Me
    Unload Me
    Application.Visible = True
    ActiveWorkbook.Save
    'Application.Quit
End Sub
Sub EkranDüzenle()

    On Error Resume Next
    With Me
        .BackColor = &H8000000F
        With Frame1
            .Caption = ""
            .Top = -2
            .Left = -2
            .Height = 36
            .Width = Me.Width + 12
            .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
            .PictureAlignment = fmPictureAlignmentTopLeft
            .PictureSizeMode = fmPictureSizeModeClip
            .PictureTiling = False
            With Image1
                .BackStyle = fmBackStyleTransparent
                .BorderColor = &HFF0000
                .BorderStyle = fmBorderStyleSingle
                .Top = 6
                .Left = 6
                .Height = 24
                .Width = 24
                If .Picture = vbNull Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
            End With
            With Label1
                .Caption = " " & "Mustafa ULUSARAÇ"
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleNone
                .SpecialEffect = fmSpecialEffectFlat
                .Left = 30
                .Top = 6
                .Height = 12
                .Width = 198
                .Font.Bold = True
                .ForeColor = &HFF0000
            End With
            With Label2
                .Caption = " " & "
01ulusarac@superonline.com"
                .BackStyle = fmBackStyleTransparent
                .BorderStyle = fmBorderStyleNone
                .SpecialEffect = fmSpecialEffectFlat
                .Left = 30
                .Top = 18
                .Height = 12
                .Width = 198
                .Font.Bold = True
                .ForeColor = &HFF0000
            End With
        End With
        With Label3
            .Caption = " " & "
01ulusarac@superonline.com"
            .BackStyle = fmBackStyleTransparent
            .BorderStyle = fmBorderStyleNone
            .SpecialEffect = fmSpecialEffectEtched
            .Left = 6
            .Top = 42
            .Height = 18
            .Width = Me.Width - .Left - (36 * 3) - 24 - 6
            .Font.Bold = True
            .ForeColor = &HFF0000
        End With
        With Label4
            .Caption = ""
            .SpecialEffect = fmSpecialEffectEtched
            .Left = Label3.Left + Label3.Width
            .Top = 42
            .Height = 18
            .Width = 36
            .Font.Bold = True
            .ForeColor = &HFF0000
            .TextAlign = fmTextAlignCenter
        End With
        With Label5
            .Caption = ""
            .SpecialEffect = fmSpecialEffectEtched
            .Left = Label4.Left + Label4.Width
            .Top = 42
            .Height = 18
            .Width = 36
            .Font.Bold = True
            .ForeColor = &HFF0000
            .TextAlign = fmTextAlignCenter
        End With
        With Label6
            .Caption = ""
            .SpecialEffect = fmSpecialEffectEtched
            .Left = Label5.Left + Label5.Width
            .Top = 42
            .Height = 18
            .Width = 36
            .Font.Bold = True
            .ForeColor = &HFF0000
            .TextAlign = fmTextAlignCenter
        End With
        With CommandButton1
            .Top = 42
            .Height = 18
            .Width = 18
            .Left = Label6.Left + Label6.Width
            .Picture = Application.CommandBars.Item(3).Controls(2).Picture
        End With
        With Frame2
            .Caption = ""
            .Left = 6
            .Top = 60
            .Width = Me.Width - .Left - 12
            .Height = Me.Height - .Top - 24 - 6
            .ScrollBars = fmScrollBarsBoth
            .PictureSizeMode = fmPictureSizeModeStretch
            .BackColor = &H80000006
            .BorderStyle = fmBorderStyleSingle
            .BorderColor = vbBlue
            With Frame3
                .Caption = ""
                .Left = 6
                .Top = 6
                .Width = 36
                .Height = 36
                .ScrollBars = fmScrollBarsNone
                .PictureSizeMode = fmPictureSizeModeClip
                .BackColor = &H80000006
                .BorderStyle = fmBorderStyleSingle
                .BorderColor = vbBlue
            End With
        End With
    End With
End Sub
 
'Module1
 
Sub FormAç()
    On Error Resume Next
    Load UserForm1
End Sub
 
'Class1
 
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Pencere As Long, ByVal Koordinat As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal Pencere As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal Pencere As Long, ByVal Eylem As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal Pencere As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal Pencere As Long, ByVal Anahtar As Long, ByVal Yoğunluk As Byte, ByVal İkinci_İşaret As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal Pencere As Long, ByVal Eski_Durum As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal FormMenü As Long, ByVal Pozisyon As Long, ByVal İlk_İşaret As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Pencere_Düzeni As Long, ByVal Mesaj As Long, ByVal Değişken1 As Long, Değişken2 As Any) As Long
Dim Çerçeve As Long, Tarz As Long, Logo As Long
Dim i As Integer, Derece As Double
Public Property Set LogoYerleştir(Form As Object)
    On Error Resume Next
    Logo = Form.Image1.Picture.Handle
    Çerçeve = FindWindow(vbNullString, Form.Caption)
    Call SendMessage(Çerçeve, &H80, 0&, ByVal Logo)
    Call SendMessage(Çerçeve, &H80, 1&, ByVal Logo)
End Property
Public Property Set Form1(Form As Object)

    On Error Resume Next
    Çerçeve = FindWindow(vbNullString, Form.Caption)
    Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
    SetWindowLong Çerçeve, (-16), Tarz
    ShowWindow Çerçeve, 3 '5= Normal Açar
    DrawMenuBar Çerçeve
End Property
Public Property Set FormGörün(Form As Object)

    On Error Resume Next
    For i = 1 To 255
        SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
        SetLayeredWindowAttributes Çerçeve, 0, i, &H2
        Çerçeve = FindWindow(vbNullString, Form.Caption)
        Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
        SetWindowLong Çerçeve, (-16), Tarz
        ShowWindow Çerçeve, 5 '3=Geniş Açar
        DrawMenuBar Çerçeve
        DoEvents
    Next i
End Property
Public Property Set FormYokol(Form As Object)

    On Error Resume Next
    For i = 1 To 255
        SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
        SetLayeredWindowAttributes Çerçeve, 0, (255 - i), &H2
        Çerçeve = FindWindow(vbNullString, Form.Caption)
        Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
        SetWindowLong Çerçeve, (-16), Tarz
        ShowWindow Çerçeve, 5
        DrawMenuBar Çerçeve
        DoEvents
    Next i
End Property
Public Property Set FormManuelYokol(Form As Object)

    On Error Resume Next
    Derece = Form.Slider1.Value
    SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
    SetLayeredWindowAttributes Çerçeve, 0, (255 - Derece), &H2
    Çerçeve = FindWindow(vbNullString, Form.Caption)
    Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
    SetWindowLong Çerçeve, (-16), Tarz
    ShowWindow Çerçeve, 5 '3
    DrawMenuBar Çerçeve
    DoEvents
End Property
Public Property Set KapatEtkili(Form As Object)

    On Error Resume Next
    DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 1), &HF060, 0&
    DrawMenuBar Çerçeve
End Property
Public Property Set KapatEtkisiz(Form As Object)

    On Error Resume Next
    DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 0), &HF060, 0&
    DrawMenuBar Çerçeve
End Property
 
 


10 Şubat 2004 Salı

Pareto (ABC) And Deviation Analysis




'UserForm1
'A) Normal Reference Add

'1 Visual Basıc For Applications;
'2 Microsoft Excel 11.0 Object Library
'3 Microsoft Forms 2.0 Object Library
'4 Microsoft Windows Common Controls 6.0 (SP6)
'5 OLE Automation
'6 Microsoft Office 11.0 Object Library
'7 Wicrosoft Office WebComponents 11.0
'B) Tools Add on UserForm1\
'1. Frame1
'2. Frame1\Image1, Label1, Label2, Label3, Label4, Label5, TextBox1, TextBox2, TextBox3
'3. ListView1
Option Explicit
Dim i As Single, ii As Single, iii As Single, Sayaç As Single
Dim Hesap(1 To 30) As Double, GenelToplam As Double, KümülatifOran As Double, A As Double, B As Double, C As Double, Oran As Double, No As Double
Private EkranBezeme As New Class1
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Pareto (ABC) And Deviation Analysis"
Application.Visible = False
Application.VBE.MainWindow.Visible = False
Set EkranBezeme.ResimEkle = Me
Set EkranBezeme.Ekran2 = Me
Call EkranDüzenle
Call ListeDüzenle
A = 80: B = 15: C = 100 - (A + B)
TextBox1 = A: TextBox2 = B: TextBox3 = C
End Sub
Private Sub UserForm_Activate()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
End Sub
Private Sub UserForm_Resize()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
Call EkranDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
Application.Visible = True
End
End Sub
Private Sub TextBox1_Change()

On Error Resume Next
A = TextBox1.Value
B = TextBox2.Value
C = 100 - (A + B)
TextBox3.Value = C
End Sub
Private Sub TextBox2_Change()


On Error Resume Next
A = TextBox1.Value
B = TextBox2.Value
C = 100 - (A + B)
TextBox3.Value = C
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

On Error Resume Next
If ColumnHeader.Key = "KAğırlık" Then Call OranaGöreSırala
If ColumnHeader.Key = "KNo" Then Call NumarayaGöreSırala
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.BackColor = &H80000016
With Frame1
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
.Picture = LoadPicture("C:\Windows\River Sumida.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True :.Caption = "": .SpecialEffect = fmSpecialEffectFlat
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = vbWhite'
&HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = vbWhite'
&HFF0000
End With
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = vbWhite'
&HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
End With
With TextBox3
.Top = 8
.Height = 18
.Width = 24
.Left = Me.Width - .Width - 12
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
.Locked = True
End With
With Label5
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox3.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " C Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
With TextBox2
.Top = 8
.Height = 18
.Width = 24
.Left = Label5.Left - .Width
.BackStyle = fmBackStyleOpaque
.ForeColor = vbGreen
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
End With
With Label4
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox2.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " B Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
With TextBox1
.Top = 8
.Height = 18
.Width = 24
.Left = Label4.Left - .Width
.BackStyle = fmBackStyleOpaque
.ForeColor = vbRed
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.SpecialEffect = fmSpecialEffectEtched
End With
With Label3
.Top = 8
.Width = 36
.Height = 18
.Left = TextBox1.Left - .Width
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignLeft
.Caption = " A Grubu"
.BackStyle = fmBackStyleTransparent :.ForeColor = vbWhite'
&HFF0000
End With
End With
With ListView1
.Top = 31
.Left = 0
.Width = Me.Width - 6
.Height = Me.Height - .Top - 24
End With
End With
End Sub
Sub ListeDüzenle()

On Error Resume Next
With ListView1
.MultiSelect = False
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
With .ColumnHeaders
.Add , "KNo", "No", 24 '[Number]
.Add , , "Mal veya Hizmet", 120 '[Property or Services]
.Add , , "a", 60, 1 'to Dövizli Birim Fiyat [Foreign Currency Unit Price]
.Add , , "b", 60, 1
'to Döviz Kuru [Exchange]
.Add , , "c=a*b", 60, 1 'to Birim Fiyat [Unit Price]
.Add , , "d", 60, 1 'to Mikatar [Quantity]
.Add , , "e=c*d", 60, 1
'to Tutar [Amount]
.Add , , "f", 60, 1 't1 Dövizli Birim Fiyat [Foreign Currency Unit Price]
.Add , , "g", 60, 1 't1 Döviz Kuru [Exchange]
.Add , , "h=f*g", 60, 1
't1 Birim Fiyat [Unit Price]
.Add , , "i", 60, 1 't1 Mikatar [Quantity]
.Add , , "j=h*i", 60, 1
't1 Tutar [Amount]
.Add , , "k=f-a", 60, 1 'Dövizli Fiyat Farkı [Foreign Currency Price Difference]
.Add , , "l=g-b", 60, 1
'Kur Farkı [Exchange Difference]
.Add , , "m=h-c", 60, 1 'Birim Fiyat Farkı [Price Difference]
.Add , , "n=i-d", 60, 1 'Miktar Farkı [Quantity Difference]
.Add , , "o=j-e", 60, 1 'Tutar farkı [Amount Difference]
.Add , "KAğırlık", "Ağırlık", 60, 1 'e / Total e
.Add , , "Kümülatif", 60, 1 '(i)Ağırlık + Sum((i-1)Ağırlık)
.Add , , "p=(f-a)*g*d", 60, 1 'Dövizli Fiyat Sapma Tutarı [Deviation Value Amount of Foreign Currency]
.Add , , "q=p/e", 60, 1 'Dövizli Fiyat Sapma Oranı [Ratio of Foreign Currency Price Deviation]
.Add , , "r=(g-b)*a*d", 60, 1 'Kur Sapma Tutarı [Currency Amount Deviation]
.Add , , "s=r/e", 60, 1
'Kur Sapma Oranı [Foreign Exchange Rate Deviation]
.Add , , "t=p+r or t=(h-c)*d", 60, 1
'Fiyat Sapma Tutarı [Deviation Value Amount]
.Add , , "u=p/e", 60, 1
'Fiyat Sapma Oranı [Deviation Value Ratio]
.Add , , "v=(i-d)*c", 60, 1
'Miktar Sapma Tutarı [Quantity Amount Deviation]
.Add , , "w=v/e", 60, 1 'Miktar Sapma Oranı [Quantity Deviation Ratio]
.Add , , "x=(h-c)*(i-d)", 60, 1 'Miktar Farkının Fiyat Sapma Tutarı[Deviation of the Value Quantity Amount Difference]
.Add , , "y=x/e", 60, 1 'Miktar Farkının Fiyat Sapma Oranı[Quantity Variance Ratio of Value Deviation]
.Add , , "z=t+v+x", 60, 1 'Toplam Sapma Tutarı [Total Amount of Deviation]
.Add , , "aa=z/e", 60, 1 'Toplam Sapma Oranı [Total Deviation Ratio]
End With
.ForeColor = VBA.vbBlack
GenelToplam = 0
KümülatifOran = 0
For i = 1 To 100
.ListItems.Add i, "Key" & i, i
With .ListItems(i)
.SubItems(1) = "Mal ve Hizmet " & i
.SubItems(2) = VBA.Format(VBA.Rnd() * 1000, "###,##0.00"): Hesap(2) = .SubItems(2)
'a= to Dövizli Birim Fiyat [Foreign Currency Unit Price]
.SubItems(3) = VBA.Format(VBA.Rnd() * 10, "###,##0.00"): Hesap(3) = .SubItems(3)
'b= to Döviz Kuru [Exchange].SubItems(4) = VBA.Format(Hesap(2) * Hesap(3), "###,##0.00"): Hesap(4) = .SubItems(4) 'c= to Birim Fiyat [Unit Price]
.SubItems(5) = VBA.Format(VBA.Rnd() * 100, "###,##0.00"): Hesap(5) = .SubItems(5) 'd= to Mikatar [Quantity]
.SubItems(6) = VBA.Format(Hesap(4) * Hesap(5), "###,##0.00"): Hesap(6) = .SubItems(6) 'e= to Tutar [Amount]
.SubItems(7) = VBA.Format(VBA.Rnd() * 1000, "###,##0.00"): Hesap(7) = .SubItems(7) 'f= t1 Dövizli Birim Fiyat [Foreign Currency Unit Price]
.SubItems(8) = VBA.Format(VBA.Rnd() * 10, "###,##0.00"): Hesap(8) = .SubItems(8)
'g= t1 Döviz Kuru [Exchange]
.SubItems(9) = VBA.Format(Hesap(7) * Hesap(8), "###,##0.00"): Hesap(9) = .SubItems(9) 'h= t1 Birim Fiyat [Unit Price]
.SubItems(10) = VBA.Format(VBA.Rnd() * 100, "###,##0.00"): Hesap(10) = .SubItems(10) 'i= t1 Mikatar [Quantity]
.SubItems(11) = VBA.Format(Hesap(9) * Hesap(10), "###,##0.00"): Hesap(11) = .SubItems(11)
'j= t1 Tutar [Amount]
.SubItems(12) = VBA.Format(Hesap(7) - Hesap(1), "###,##0.00"): Hesap(12) = .SubItems(12) 'k= Dövizli Fiyat Farkı [Foreign Currency Price Difference]
.SubItems(13) = VBA.Format(Hesap(8) - Hesap(3), "###,##0.00"): Hesap(13) = .SubItems(13)
'l= Kur Farkı [Exchange Difference]
.SubItems(14) = VBA.Format(Hesap(9) - Hesap(4), "###,##0.00"): Hesap(14) = .SubItems(14) 'm= Birim Fiyat Farkı [Price Difference]

.SubItems(15) = VBA.Format(Hesap(10) - Hesap(5), "###,##0.00"): Hesap(15) = .SubItems(15) 'n= Miktar Farkı [Quantity Difference]
.SubItems(16) = VBA.Format(Hesap(11) - Hesap(6), "###,##0.00"): Hesap(16) = .SubItems(16) 'o= Tutar farkı [Amount Difference]
.SubItems(17) = 0: Hesap(17) = .SubItems(17) 'e / Total e
.SubItems(18) = 0: Hesap(18) = .SubItems(18) 'e / Total e
.SubItems(19) = VBA.Format(Hesap(12) * Hesap(5) * Hesap(8), "###,##0.00"): Hesap(19) = .SubItems(19) 'p= Dövizli Fiyat Sapma Tutarı [Deviation Value Amount of Foreign Currency]
.SubItems(20) = VBA.Format(Hesap(19) / Hesap(6), "%0.00") 'q= Dövizli Fiyat Sapma Oranı [Ratio of Foreign Currency Price Deviation]
.SubItems(21) = VBA.Format(Hesap(13) * Hesap(2) * Hesap(5), "###,##0.00"): Hesap(21) = .SubItems(21) 'r= Kur Sapma Tutarı [Currency Amount Deviation]
.SubItems(22) = VBA.Format(Hesap(21) / Hesap(6), "%0.00") 's= Kur Sapma Oranı [Foreign Exchange Rate Deviation]
.SubItems(23) = VBA.Format(Hesap(19) + Hesap(21), "###,##0.00"): Hesap(23) = .SubItems(23) 't= Fiyat Sapma Tutarı [Deviation Value Amount]
.SubItems(24) = VBA.Format(Hesap(23) / Hesap(6), "%0.00")
'u= Fiyat Sapma Oranı [Deviation Value Ratio]
.SubItems(25) = VBA.Format(Hesap(15) * Hesap(4), "###,##0.00"): Hesap(25) = .SubItems(25) 'v= Miktar Sapma Tutarı [Quantity Amount Deviation]
.SubItems(26) = VBA.Format(Hesap(25) / Hesap(6), "%0.00")
'w= Miktar Sapma Oranı [Quantity Deviation Ratio]
.SubItems(27) = VBA.Format(Hesap(14) * Hesap(15), "###,##0.00"): Hesap(27) = .SubItems(27) 'x= Miktar Farkının Fiyat Sapma Tutarı[Deviation of the Value Quantity Amount Difference]
.SubItems(28) = VBA.Format(Hesap(27) / Hesap(6), "%0.00")
'y= Miktar Farkının Fiyat Sapma Oranı[Quantity Variance Ratio of Value Deviation]
.SubItems(29) = VBA.Format(Hesap(23) + Hesap(25) + Hesap(27), "###,##0.00"): Hesap(29) = .SubItems(29)
'z= Toplam Sapma Tutarı [Total Amount of Deviation]
.SubItems(30) = VBA.Format(Hesap(29) / Hesap(6), "%0.00")
'aa= Toplam Sapma Oranı [Total Deviation Ratio]
End With
GenelToplam = GenelToplam + Hesap(6)
Next i
For i = 1 To 100
Hesap(6) = .ListItems(i).SubItems(6)
Hesap(17) = 100 * Hesap(6) / GenelToplam
.ListItems(i).SubItems(17) = VBA.Format(Hesap(17), "##0.000000")
If i = 1 Then
.ListItems(i).SubItems(18) = Hesap(17)
KümülatifOran = .ListItems(i).SubItems(18)
Else
.ListItems(i).SubItems(18) = Hesap(17) + KümülatifOran
KümülatifOran = .ListItems(i).SubItems(18)
End If
Next i
End With
End Sub
Sub OranaGöreSırala()

On Error Resume Next
ReDim Kolon(1 To 100)
ReDim Dublör(1 To 100, 0 To 30)
A = TextBox1.Value
B = TextBox2.Value
C = TextBox3.Value
For i = 1 To 100
Dublör(i, 0) = ListView1.ListItems(i)
For ii = 1 To 30
Dublör(i, ii) = ListView1.ListItems(i).SubItems(ii)
If ii = 17 Then
Oran = ListView1.ListItems(i).SubItems(ii)
Kolon(i) = Oran
End If
Next ii
Next i
ListView1.ListItems.Clear
KümülatifOran = 0
Sayaç = 0
For i = 1 To 100
Sayaç = Sayaç + 1
Oran = Application.WorksheetFunction.Max(Kolon)
No = Application.WorksheetFunction.Match(Oran, Kolon, 0)
Kolon(No) = 0
With ListView1
.ListItems.Add Sayaç, "Key" & Sayaç, No
For ii = 1 To 30
If ii = 18 Then
If Sayaç = 1 Then
KümülatifOran = Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
Else
KümülatifOran = KümülatifOran + Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
End If
Else
.ListItems(Sayaç).SubItems(ii) = Dublör(No, ii)
End If
Next ii
Select Case KümülatifOran
Case 0 To A
Call SatırBoya(i, TextBox1.ForeColor)
Case A To (A + B)
Call SatırBoya(i, TextBox2.ForeColor)
Case (A + B) To (A + B + C)
Call SatırBoya(i, TextBox3.ForeColor)
End Select
End With
Next i
Erase Kolon
Erase Dublör
End Sub
Sub NumarayaGöreSırala()

On Error Resume Next
ReDim Kolon(1 To 100)
ReDim Dublör(1 To 100, 0 To 30)
A = TextBox1.Value
B = TextBox2.Value
C = TextBox3.Value
For i = 1 To 100
Dublör(i, 0) = ListView1.ListItems(i)
Oran = ListView1.ListItems(i)
Kolon(i) = Oran
For ii = 1 To 30
Dublör(i, ii) = ListView1.ListItems(i).SubItems(ii)
Next ii
Next i
ListView1.ListItems.Clear
KümülatifOran = 0
Sayaç = 0
For i = 1 To 100
Sayaç = Sayaç + 1
Oran = Application.WorksheetFunction.Min(Kolon)
No = Application.WorksheetFunction.Match(Oran, Kolon, 0)
Kolon(No) = ""
With ListView1
.ListItems.Add Sayaç, "Key" & Sayaç, Oran
For ii = 1 To 30
If ii = 18 Then
If Sayaç = 1 Then
KümülatifOran = Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
Else
KümülatifOran = KümülatifOran + Oran
.ListItems(Sayaç).SubItems(ii) = VBA.Round(KümülatifOran, 4)
End If
Else
.ListItems(Sayaç).SubItems(ii) = Dublör(No, ii)
End If
Next ii
Call SatırBoya(i, VBA.vbBlack)
End With
Next i
Erase Kolon
Erase Dublör
End Sub
Private Function SatırBoya(ByVal Satır As Double, ByVal Renk As Variant)

With ListView1
.ListItems(Satır).ForeColor = Renk
For iii = 1 To 30
.ListItems(Satır).ListSubItems(iii).ForeColor = Renk
Next iii
End With
End Function

'Module1

Sub FormAç()

On Error Resume Next
Load UserForm1
End Sub

'Class1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal ClassName As String, ByVal WindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal Index As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal Index As Long, ByVal NewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Const PDSM As Long = &H80000
'Pencere Düzeni Sistem Menülü

Private Const PDTD As Long = &H30000 'Pencere Düzeni Tam Düğmeli
Private Const PDKD As Long = &H20000
'Pencere Düzeni Küçültme Düğmeli
Private Const PDBD As Long = &H10000
'Pencere Düzeni Büyültme Düğmeli

Private Const PDDÇ As Long = &H1 'Pencere Düzeni DiyalogÇerçeveli (Excel 4.0)
Private Const PDEA As Long = &H80 'Pencere Düzeni Eski Araçlı
Private Const PDYÇ As Long = -16 'Pencere Düzeni Yeni Çağırmalı
Private Const PDEÇ As Long = -20 'Pencere Düzeni Eski Çağırmalı
Private Const PDGA As Long = 3 'Pencere Düzeni Geniş Açmalı
Private Const PDNA As Long = 5 'Pencere Düzeni Normal Açmalı
Private Pencere As Long, Çerçeve As Long
Private Resimlik As New ImageList, Resim
Private Sürüm As Double
Public Property Set ResimEkle(ByVal Ekran As Object) 'Add Logo as Icon

On Error Resume Next
Sürüm = VBA.Val(Application.Version)
Resimlik.ListImages.Add 1, "Key1", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")
Set Resim = Resimlik.ListImages(1).Picture
Select Case Sürüm
Case 1 To 8
Pencere = FindWindow("ThunderXFrame", Ekran.Caption)
Case 9 To 99
Pencere = FindWindow("ThunderDFrame", Ekran.Caption)
End Select
If Pencere = 0 Then Exit Property
SendMessage Pencere, PDEA, True, Resim: SendMessage Pencere, PDEA, False, Resim
Çerçeve = GetWindowLong(Pencere, PDEÇ): Çerçeve = Çerçeve And Not PDDÇ
SetWindowLong Pencere, PDEÇ, Çerçeve
DrawMenuBar Pencere
End Property
Public Property Set Ekran1(ByVal Ekran As Object) '
[+][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran2(ByVal Ekran As Object)
'[+][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDGA
DrawMenuBar Pencere
End Property
Public Property Set Ekran3(ByVal Ekran As Object)
'[-][+][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDBD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran4(ByVal Ekran As Object)
'[+][-][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDKD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran5(ByVal Ekran As Object)
'[][][+]

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) Or PDSM
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran6(objForm As Object)
'[][][]

On Error Resume Next
Pencere = FindWindow(vbNullString, objForm.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) And Not PDSM
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property
Public Property Set Ekran7(ByVal Ekran As Object)
'Çerçevesiz ve Menüsüz UserForm

On Error Resume Next
Pencere = FindWindow(vbNullString, Ekran.Caption)
Çerçeve = GetWindowLong(Pencere, (PDYÇ)) And PDTD
SetWindowLong Pencere, (PDYÇ), Çerçeve
ShowWindow Pencere, PDNA
DrawMenuBar Pencere
End Property

'Module2

Sub Sapma_Analizi2() ''Deviation Analysis    
On Error Resume Next
    Dim WS As Worksheet
    Application.DisplayAlerts = False
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = "Sapma_Analizi" Then WS.Name = WS.Name & "_" & VBA.Hour(VBA.Now) & "_" & VBA.Minute(VBA.Now) & "_" & VBA.Second(VBA.Now)
    Next WS
    ThisWorkbook.Worksheets.Add
    With ActiveSheet
        .Unprotect
        .Name = "Sapma_Analizi"
    End With
    Columns("A:A").ColumnWidth = 1
    Columns("B:B").ColumnWidth = 12
    Columns("C:C").ColumnWidth = 28
    Columns("D:D").ColumnWidth = 14
    Columns("E:E").ColumnWidth = 14
    Columns("F:F").ColumnWidth = 14
    Columns("G:G").ColumnWidth = 14
    Columns("H:H").ColumnWidth = 12
    Columns("I:I").ColumnWidth = 1
    Range("B2").FormulaR1C1 = "Ürün No"
    Range("B3").FormulaR1C1 = "Ürün Adı"
    Range("B4").FormulaR1C1 = "Ürün Birimi"
    Range("C2").FormulaR1C1 = "'14.021-K"
    Range("C3").FormulaR1C1 = "Cevher Nakli İçin Galeri Açılması"
    Range("C4").FormulaR1C1 = "m³"
    Range("B6").FormulaR1C1 = "BÜTÇE KARŞILAŞTIRMALI SAPMA (Deviation) ANALİZİ"
    Range("B8").FormulaR1C1 = "Sapma Analizine Esas Veri tabanı"
    Range("E8").FormulaR1C1 = "Bütçe"
    Range("E9").FormulaR1C1 = "A"
    Range("F8").FormulaR1C1 = "Fiili"
    Range("F9").FormulaR1C1 = "B"
    Range("G8").FormulaR1C1 = "Fark"
    Range("G9").FormulaR1C1 = "C = A - B"
    Range("H8").FormulaR1C1 = "Fark %"
    Range("H9").FormulaR1C1 = "D = C / A"
    Range("B10").FormulaR1C1 = "a"
    Range("B11").FormulaR1C1 = "b"
    Range("B12").FormulaR1C1 = "c = a * b"
    Range("B13").FormulaR1C1 = "d"
    Range("B14").FormulaR1C1 = "e = c * d"
    Range("C10").FormulaR1C1 = "Miktar"
    Range("C11").FormulaR1C1 = "Dövizli Birim Fiyat"
    Range("C12").FormulaR1C1 = "Dövizli Tutar"
    Range("C13").FormulaR1C1 = "Ortalama Döviz Kuru Kur"
    Range("C14").FormulaR1C1 = "TL Tutar"
    Range("E10").FormulaR1C1 = "1000"
    Range("E11").FormulaR1C1 = "650"
    Range("E12").FormulaR1C1 = "=R[-1]C*R[-2]C"
    Range("E13").FormulaR1C1 = "2.98"
    Range("E14").FormulaR1C1 = "=R[-2]C*R[-1]C"
    Range("F10").FormulaR1C1 = "1100"
    Range("F11").FormulaR1C1 = "675"
    Range("F12").FormulaR1C1 = "=R[-1]C*R[-2]C"
    Range("F13").FormulaR1C1 = "2.8"
    Range("F14").FormulaR1C1 = "=R[-2]C*R[-1]C"
    Range("G10").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G11").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G12").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G13").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G14").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("H10").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H11").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H12").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H13").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H14").FormulaR1C1 = "=RC[-1]/RC[-3]"
    With Range("E10:F11,E13:F13")
        With .Font
            .Name = "Arial"
            .FontStyle = "Normal"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 32
        End With
        .Locked = False
        .FormulaHidden = False
    End With
    Range("E10:G14").NumberFormat = "#,##0.00"
    Range("H10:H14").NumberFormat = "0.00%"
    Range("E11,F11,G11,E12,F12,G12").NumberFormat = "[$$-409]#,##0.00"
    Range("E13:G13").NumberFormat = "#,##0.00 ""TL/$"""
    Range("E14:G14").NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("B16").FormulaR1C1 = "Sapma Analizi İşlem Tanımı"
    Range("B17").FormulaR1C1 = "f"
    Range("B18").FormulaR1C1 = "g"
    Range("B19").FormulaR1C1 = "h"
    Range("B20").FormulaR1C1 = "i = f + g + h"
    Range("B21").FormulaR1C1 = "j"
    Range("B22").FormulaR1C1 = "k = i + j"
    Range("C17").FormulaR1C1 = "Fiyat Sapma Tutarı"
    Range("C18").FormulaR1C1 = "Miktar Sapma Tutarı"
    Range("C19").FormulaR1C1 = "Miktar farkının Fiyat Sapma Tutarı"
    Range("C20").FormulaR1C1 = "Kur Ondülasyonu Hariç Sapma Tutarı"
    Range("C21").FormulaR1C1 = "Kur Ondülasyonu Sapma Tutarı"
    Range("C22").FormulaR1C1 = "Toplam Sapma Tutarı"
    Range("D16").FormulaR1C1 = "i"
    Range("D17").FormulaR1C1 = "=R[-6]C[3]"
    Range("D18").FormulaR1C1 = "=R[-8]C[3]"
    Range("D19").FormulaR1C1 = "=R[-9]C[3]"
    Range("D21").FormulaR1C1 = "=R[-10]C[1]"
    Range("E16").FormulaR1C1 = "ii"
    Range("E17").FormulaR1C1 = "=R[-7]C[1]"
    Range("E18").FormulaR1C1 = "=R[-7]C[1]"
    Range("E19").FormulaR1C1 = "=R[-8]C[2]"
    Range("E21").FormulaR1C1 = "=R[-11]C"
    Range("F16").FormulaR1C1 = "iii"
    Range("F17").FormulaR1C1 = "=R[-4]C"
    Range("F18").FormulaR1C1 = "=R[-5]C"
    Range("F19").FormulaR1C1 = "=R[-6]C"
    Range("F21").FormulaR1C1 = "=R[-8]C[1]"
    Range("G16").FormulaR1C1 = "iv = i * ii * iii"
    Range("G17").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G18").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G19").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G20").FormulaR1C1 = "=R[-1]C+R[-2]C+R[-3]C"
    Range("G21").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G22").FormulaR1C1 = "=R[-1]C+R[-2]C"
    Range("H16").FormulaR1C1 = "v = Ae"
    Range("H17").FormulaR1C1 = "=RC[-1]/R[-3]C[-3]"
    Range("H18").FormulaR1C1 = "=RC[-1]/R[-4]C[-3]"
    Range("H19").FormulaR1C1 = "=RC[-1]/R[-5]C[-3]"
    Range("H20").FormulaR1C1 = "=RC[-1]/R[-6]C[-3]"
    Range("H21").FormulaR1C1 = "=RC[-1]/R[-7]C[-3]"
    Range("H22").FormulaR1C1 = "=RC[-1]/R[-8]C[-3]"
    Range("J17").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Yapılan işte yaşanan pahalılık"",""Yapılan işte yaşanan uzuzluk""))"
    Range("J18").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Fiili fiyat ve kurdan fazla yapılan harcama"",""Fiili fiyat ve kurdan eksik yapılan harcama""))"
    Range("J19").FormulaR1C1 = "=IF(AND(RC[-6]<0,RC[-5]<0),""Fazla yapılan işte yaşanan pahalılık"",IF(AND(RC[-6]<0,RC[-5]>0),""Fazla yapılan işte yaşanan ucuzluk"",IF(AND(RC[-6]>0,RC[-5]<0),""Eksik yapılan işte yaşanan pahalılık"",IF(AND(RC[-6]>0,RC[-5]>0),""Eksik yapılan işte yaşanan ucuzluk"",""""))))"
    Range("J20").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Fiili kurlarla yapılan fazla harcama"",""Fiili kurlarla yapılan eksik harcama""))"
    Range("J21").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Kur ondülasyonundan kaynaklanan pahalılık"",""Kur ondülasyonundan kaynaklanan ucuzluk""))"
    Range("J22").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Öngörülene göre yapılan fazla harcama"",""Öngörülene göre yapılan eksik harcama""))"
    Range("G17:G22").NumberFormat = "#,##0.00 $"
    Range("H17:H22").NumberFormat = "0.00%"
    Range("B24").FormulaR1C1 = "ÖNCEKİ DÖNEM KARŞILAŞTIRMALI SAPMA (Deviation) ANALİZİ"
    Range("B26").FormulaR1C1 = "Sapma Analizine Esas Veri tabanı"
    Range("B28").FormulaR1C1 = "a"
    Range("B29").FormulaR1C1 = "b"
    Range("B30").FormulaR1C1 = "c = a * b"
    Range("B31").FormulaR1C1 = "d"
    Range("B32").FormulaR1C1 = "e = c * d"
    Range("C28").FormulaR1C1 = "Miktar"
    Range("C29").FormulaR1C1 = "Dövizli Birim Fiyat"
    Range("C30").FormulaR1C1 = "Dövizli Tutar"
    Range("C31").FormulaR1C1 = "Ortalama Döviz Kuru Kur"
    Range("C32").FormulaR1C1 = "TL Tutar"
    Range("E26").FormulaR1C1 = "Önceki Dönem"
    Range("E27").FormulaR1C1 = "A"
    Range("E28").FormulaR1C1 = "1100"
    Range("E29").FormulaR1C1 = "675"
    Range("E30").FormulaR1C1 = "=R[-1]C*R[-2]C"
    Range("E31").FormulaR1C1 = "2.8"
    Range("E32").FormulaR1C1 = "=R[-2]C*R[-1]C"
    Range("F26").FormulaR1C1 = "Dönem"
    Range("F27").FormulaR1C1 = "B"
    Range("F28").FormulaR1C1 = "1000"
    Range("F29").FormulaR1C1 = "650"
    Range("F30").FormulaR1C1 = "=R[-1]C*R[-2]C"
    Range("F31").FormulaR1C1 = "2.98"
    Range("F32").FormulaR1C1 = "=R[-2]C*R[-1]C"
    Range("G26").FormulaR1C1 = "Fark"
    Range("G27").FormulaR1C1 = "C = A - B"
    Range("G28").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G29").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G30").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G31").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("G32").FormulaR1C1 = "=RC[-2]-RC[-1]"
    Range("H26").FormulaR1C1 = "Fark %"
    Range("H27").FormulaR1C1 = "D = C / A"
    Range("H28").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H29").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H30").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H31").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("H32").FormulaR1C1 = "=RC[-1]/RC[-3]"
    Range("B34").FormulaR1C1 = "Sapma Analizi İşlem Tanımı"
    Range("B35").FormulaR1C1 = "f"
    Range("B36").FormulaR1C1 = "g"
    Range("B37").FormulaR1C1 = "h"
    Range("B38").FormulaR1C1 = "i = f + g + h"
    Range("B39").FormulaR1C1 = "j"
    Range("B40").FormulaR1C1 = "k = i + j"
    Range("C35").FormulaR1C1 = "Fiyat Sapma Tutarı"
    Range("C36").FormulaR1C1 = "Miktar Sapma Tutarı"
    Range("C37").FormulaR1C1 = "Miktar farkının Fiyat Sapma Tutarı"
    Range("C38").FormulaR1C1 = "Kur Ondülasyonu Hariç Sapma Tutarı"
    Range("C39").FormulaR1C1 = "Kur Ondülasyonu Sapma Tutarı"
    Range("C40").FormulaR1C1 = "Toplam Sapma Tutarı"
    Range("D34").FormulaR1C1 = "i"
    Range("D35").FormulaR1C1 = "=R[-6]C[3]"
    Range("D36").FormulaR1C1 = "=R[-8]C[3]"
    Range("D37").FormulaR1C1 = "=R[-9]C[3]"
    Range("C38").FormulaR1C1 = "Kur Ondülasyonu Hariç Sapma Tutarı"
    Range("D39").FormulaR1C1 = "=R[-10]C[1]"
    Range("E34").FormulaR1C1 = "ii"
    Range("E35").FormulaR1C1 = "=R[-7]C[1]"
    Range("E36").FormulaR1C1 = "=R[-7]C[1]"
    Range("E37").FormulaR1C1 = "=R[-8]C[2]"
    Range("E39").FormulaR1C1 = "=R[-11]C"
    Range("F34").FormulaR1C1 = "iii"
    Range("F35").FormulaR1C1 = "=R[-4]C"
    Range("F36").FormulaR1C1 = "=R[-5]C"
    Range("F37").FormulaR1C1 = "=R[-6]C"
    Range("F39").FormulaR1C1 = "=R[-8]C[1]"
    Range("G34").FormulaR1C1 = "iv = i * ii * iii"
    Range("G35").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G36").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G37").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G38").FormulaR1C1 = "=R[-1]C+R[-2]C+R[-3]C"
    Range("G39").FormulaR1C1 = "=RC[-1]*RC[-2]*RC[-3]"
    Range("G40").FormulaR1C1 = "=R[-1]C+R[-2]C"
    Range("H34").FormulaR1C1 = "v = Ae"
    Range("H35").FormulaR1C1 = "=RC[-1]/R[-3]C[-3]"
    Range("H36").FormulaR1C1 = "=RC[-1]/R[-4]C[-3]"
    Range("H37").FormulaR1C1 = "=RC[-1]/R[-5]C[-3]"
    Range("H38").FormulaR1C1 = "=RC[-1]/R[-6]C[-3]"
    Range("H39").FormulaR1C1 = "=RC[-1]/R[-7]C[-3]"
    Range("H40").FormulaR1C1 = "=RC[-1]/R[-8]C[-3]"
    Range("J35").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Yapılan işte yaşanan pahalılık"",""Yapılan işte yaşanan uzuzluk""))"
    Range("J36").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Dönem fiyat ve kurdan fazla yapılan harcama"",""Dönem fiyat ve kurdan eksik yapılan harcama""))"
    Range("J37").FormulaR1C1 = "=IF(AND(RC[-6]<0,RC[-5]<0),""Fazla yapılan işte yaşanan pahalılık"",IF(AND(RC[-6]<0,RC[-5]>0),""Fazla yapılan işte yaşanan ucuzluk"",IF(AND(RC[-6]>0,RC[-5]<0),""Eksik yapılan işte yaşanan pahalılık"",IF(AND(RC[-6]>0,RC[-5]>0),""Eksik yapılan işte yaşanan ucuzluk"",""""))))"
    Range("J38").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Dönem kurlarla yapılan fazla harcama"",""Dönem kurlarla yapılan eksik harcama""))"
    Range("J39").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Kur ondülasyonundan kaynaklanan pahalılık"",""Kur ondülasyonundan kaynaklanan ucuzluk""))"
    Range("J40").FormulaR1C1 = "=IF(RC[-3]=0,"""",IF(RC[-3]<0,""Önceki deneme göre yapılan fazla harcama"",""Önceki döneme göre yapılan eksik harcama""))"
    With Range("B2:C4")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("C2:C4")
        With .Font
            .Name = "Arial"
            .FontStyle = "Normal"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 32
        End With
        .Locked = False
        .FormulaHidden = False
    End With
    With Range("B6:H6")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
        .Font.Bold = True
        With .Font
            .Name = "Arial"
            .Size = 14
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
    End With
    With Range("B8:D9")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
    End With
    With Range("E8:H9")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("C10:D10,C11:D11,C12:D12,C13:D13,C14:D14")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Range("B8:H14")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("B8:H9")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("B16:C16")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Range("D16:H16")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("C20:F20")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
    End With
    With Range("C22:F22")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Merge
    End With
    With Range("B16:H22")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("B16:H16")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("E8:H14,G16:H22")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    Range("B6:H22").Copy
    Range("B24").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("C2").Select
    ActiveSheet.Protect
    Application.DisplayAlerts = True

End Sub


'Module3

Sub Calculation_of_Change_After_Inflation() 'Enflasyon sonrası değişimi hesaplama
    
On Error Resume Next
    Dim i As Integer
    Dim Bellek As Variant
    Application.DisplayAlerts = False
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name = "Change_After_Inflation" Then WS.Name = WS.Name & "_" & VBA.Hour(VBA.Now) & "_" & VBA.Minute(VBA.Now) & "_" & VBA.Second(VBA.Now)
    Next WS
    ThisWorkbook.Worksheets.Add
    With ActiveSheet
        .Unprotect
        .Name = "Change_After_Inflation"
    End With
    Columns("A:A").ColumnWidth = 1
    Columns("B:B").ColumnWidth = 3
    Columns("C:C").ColumnWidth = 72
    Columns("D:D").ColumnWidth = 19
    Columns("E:E").ColumnWidth = 1
    Range("2:2,4:4,5:5,6:6,7:7,8:8,9:9,10:10,11:11").RowHeight = 18
    Range("B2").FormulaR1C1 = "ENFLASYONDAN ARINDIRILMIŞ GSYH DEĞİŞİM HESABI (1000000)"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = ""
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "a"
    Range("B5").FormulaR1C1 = "b"
    Range("B6").FormulaR1C1 = "c"
    Range("B7").FormulaR1C1 = "d"
    Range("B8").FormulaR1C1 = "e"
    Range("B9").FormulaR1C1 = "f"
    Range("B10").FormulaR1C1 = "g"
    Range("B11").FormulaR1C1 = "h"
    Range("C4").FormulaR1C1 = "Alıcı Fiyatlarıyla I. Dönem GSYH"
    Range("C5").FormulaR1C1 = "Alıcı Fiyatlarıyla II. Dönem GSYH"
    Range("C6").FormulaR1C1 = "Enflasyon Öncesi GSYH Değişimi [b-a]"
    Range("C7").FormulaR1C1 = "Enflasyon Öncesi GSYH Değişim Oranı [c/a]"
    Range("C8").FormulaR1C1 = "Ağırlıklandırılmış Dönem İçi ÜFE "
    Range("C9").FormulaR1C1 = "Enflasyon Sonrası GSYH Değişim Oranı  [(d-e)-((d-e)*e)/(1+e)]"
    Range("C10").FormulaR1C1 = "Önceki Dönem Fiyatlarıyla Düzeltilmiş II. Dönem GSYH [a*(1+f)]"
    Range("C11").FormulaR1C1 = "Önceki Dönem Fiyatlarıyla Düzeltilmiş II. Dönem GSYH Değişimi [g-a]"
    Range("D4").FormulaR1C1 = "28864.2"
    Range("D5").FormulaR1C1 = "32246.11"
    Range("D6").FormulaR1C1 = "=R[-1]C-R[-2]C"
    Range("D7").FormulaR1C1 = "=R[-1]C/R[-3]C"
    Range("D8").FormulaR1C1 = "6.97%"
    Range("D9").FormulaR1C1 = "=(R[-2]C-R[-1]C)-((R[-2]C-R[-1]C)*R[-1]C)/(1+R[-1]C)"
    Range("D10").FormulaR1C1 = "=R[-6]C*(1+R[-1]C)"
    Range("D11").FormulaR1C1 = "=R[-1]C-R[-7]C"
    With Range("B2:D11").Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Range("D4:D5")
        .NumberFormat = "#,##0.00 $"
        With .Font
            .Name = "Arial"
            .FontStyle = "Normal"
            .Size = 12
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 32
        End With
        .Locked = False
        .FormulaHidden = False
    End With
    Range("D10:D11").NumberFormat = "#,##0.00 $"
    Range("D6").NumberFormat = "#,##0.00 $"
    Range("D7:D9").NumberFormat = "0.00%"
    With Range("B4:D11")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
        With Range("D4:D11")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
    With Range("B5:D5,B10:D10").Interior
        .ColorIndex = 36
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    With Range("B2")
        .Characters(Start:=1, Length:=46).Font.Size = 16
        .Characters(Start:=47, Length:=9).Font.Size = 8
    End With
    With Range("D8")
        With .Font
            .Name = "Arial"
            .FontStyle = "Normal"
            .Size = 12
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = 32
        End With
        .Locked = False
        .FormulaHidden = False
    End With
    With Range("C9")
        .Characters(Start:=41, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=43, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=48, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=50, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=53, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=57, Length:=1).Font.FontStyle = "Kalın"
        .Characters(Start:=59, Length:=1).Font.FontStyle = "Kalın"
    End With
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
    End With
    ActiveSheet.Protect
    Application.DisplayAlerts = True
    Range("B4").Select

End Sub
 

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul