Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Ekim 2012 Çarşamba

Kamu Desteği Dışında Yapılan Teşvikli Yatırımlarda Yatırıma Katkıpayı Kullanımı [1]




'Module1



'Available References List
    '1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
    '2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
    '3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
    '4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
    '5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL

Option Explicit
Private hSingle As Single
Private Logo As New OLEObject
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Private Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Private IPic(15) As Byte
Private Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const URL1 As String = "
http://3.bp.blogspot.com/-JnmFGcm3ApU/To74s1xm3iI/AAAAAAAAC30/6bT2SxszQQM/s1600/excel_2003_gif.gif"
Private URL As String
Sub Tablo_Kur()
    On Error Resume Next
    Sheets(1).Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("B1").FormulaR1C1 = "KAMU DESTEĞİ DIŞINDA YAPILAN VE TEŞVİK KAPSAMI İÇİNDE OLAN"
    Range("B2").FormulaR1C1 = "YATIRIMA KATKI PAYINDAN YARARLANACAK YATIRIMLAR İÇİN"
    Range("B3").FormulaR1C1 = "KURUMLAR VERGİSİ HESABI [TL]"
    Range("A5:A14") = Application.WorksheetFunction.Transpose(Array("a", "b", "c", "d", "e", "f", "g", "h", "", "Yıllar"))
    For hSingle = 1 To 20
        Range("A16:A35").Cells(hSingle, 1).FormulaR1C1 = hSingle
    Next hSingle
    Range("A36").FormulaR1C1 = "Toplam"
    Range("B5").FormulaR1C1 = "Kamu Desteği Dışında Yapılan Yatırım Harcamaları"
    Range("B6").FormulaR1C1 = "Yatırıma Katkı Oranı "
    Range("B7").FormulaR1C1 = "Kurumlar Vergisi İndirim oranı "
    Range("B8").FormulaR1C1 = "Yatırıma Katkı Payı [a * b]"
    Range("B9").FormulaR1C1 = "Normal Kurumlar Vergisi Oranı"
    Range("B10").FormulaR1C1 = "İndirimli Kurumlar Vergisi Oranı [e - (e * c)]"
    Range("B11").FormulaR1C1 = "Faydalanılan Vergi İndirimi Oranı [e - f]"
    Range("B12").FormulaR1C1 = "İndirimli Oranın Uygulanacağı Vergi Öncesi Kar Üst Limiti [d / g]"
    Range("B14").FormulaR1C1 = "Vergi Öncesi Karlar"
    Range("B15").FormulaR1C1 = "i"
    Range("B16.B35").FormulaR1C1 = "1500000"
    Range("B36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("C14").FormulaR1C1 = "Kümülatif Vergi Öncesi Karlar"
    Range("C15").FormulaR1C1 = "j"
    Range("C16").FormulaR1C1 = "=+RC[-1]"
    Range("C17:C35").FormulaR1C1 = "=+RC[-1]+R[-1]C"
    Range("C36").FormulaR1C1 = "=R[-1]C"
    Range("D14").FormulaR1C1 = "İndirimli Oranın Uygulanacağı Vergi Öncesi Kar"
    Range("D15").FormulaR1C1 = "k"
    Range("D16").FormulaR1C1 = "=IF(0>IF(R12C8>RC[-1],RC[-2],R12C8),0,IF(R12C8>RC[-1],RC[-2],R12C8))"
    Range("D17:D35").FormulaR1C1 = "=IF(0>IF(R12C8>RC[-1],RC[-2],R12C8-R[-1]C[-1]),0,IF(R12C8>RC[-1],RC[-2],R12C8-R[-1]C[-1]))"
    Range("D36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("E14").FormulaR1C1 = "Normal Oranın Uygulanacağı Vergi Öncesi Kar"
    Range("E15").FormulaR1C1 = "l"
    Range("E16:E35").FormulaR1C1 = "=+RC[-3]-RC[-1]"
    Range("E36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("F14").FormulaR1C1 = "İndirimli Kurumlar Vergisi"
    Range("F15").Select
    ActiveCell.FormulaR1C1 = "m= [f * k]"
    Range("F16:F35").FormulaR1C1 = "=+RC[-2]*R10C8"
    Range("F36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("G14").FormulaR1C1 = "Normal Kurumlar Vergisi"
    Range("G15").FormulaR1C1 = "n= [e * l]"
    Range("G16:G35").FormulaR1C1 = "=+RC[-2]*R9C8"
    Range("G36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("H5").FormulaR1C1 = "4000000"
    Range("H6").FormulaR1C1 = "30%"
    Range("H7").FormulaR1C1 = "60%"
    Range("H8").FormulaR1C1 = "=+R[-2]C*R[-3]C"
    Range("H9").FormulaR1C1 = "20%"
    Range("H10").FormulaR1C1 = "=R[-1]C-(R[-1]C*R[-3]C)"
    Range("H11").FormulaR1C1 = "=R[-2]C-R[-1]C"
    Range("H12").FormulaR1C1 = "=+R[-4]C/R[-1]C"
    Range("H14").FormulaR1C1 = "Toplam Kurumlar Vergisi"
    Range("H15").FormulaR1C1 = "o= [m + n]"
    Range("H16:H35").FormulaR1C1 = "=RC[-1]+RC[-2]"
    Range("H36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("J14").FormulaR1C1 = "Yararlanılan Yatırıma Katkıpayı Tutarı"
    Range("J15").FormulaR1C1 = "p=k * g"
    Range("J16:J35").FormulaR1C1 = "=+RC[-6]*R11C8"
    Range("J36").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("A38").FormulaR1C1 = "Örnek 31.12.2010 tarihine kadar yatırıma başlanması halinde Çanakkale ili II. Bölge'de "
    Range("A39").FormulaR1C1 = "Yatırımlarda Devlet Yardımları Hakkında Kararda Değişiklik Yapılması'na yönelik 2009/15199 sayılı bakanlar kurulu kararının 10'uncu maddesi ve Kurumlar Vergisi Yasası'nın 32/A maddesinde uygulanması öngörülen indirim oranları ile yatırıma katkı oranları gereği hesaplanmıştır."
    Range("H5,H8,H12,B16:H36,J16:J36").NumberFormat = "#,##0.00"
    Range("H6,H7,H9,H10,H11").NumberFormat = "0.00%"
    With Range("A14:H15,J14:J15")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .ShrinkToFit = True
    End With
    Range("B:B,C:C,D:D,E:E,F:F,G:G,H:H,J:J").ColumnWidth = 12
    Columns("I:I").ColumnWidth = 1
    Columns("A:A").ColumnWidth = 8
    Range("4:4,13:13,37:37").RowHeight = 6
    With Range("A1:J39").Font
        .Name = "Arial"
        .Size = 8
    End With
    With Range("B5:G5,B6:G6,B7:G7,B8:G8,B9:G9,B10:G10,B11:G11,B12:G12")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .MergeCells = True
        .Merge
    End With
    With Range("A5:H12,H5:H12,A14:H36,J14:J36,A14:H15,J14:J15,A36:H36,J36:J36,A14:A36,H14:H36")
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
    With Range("A5:A12,A16:A36")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .MergeCells = False
    End With
    With Range("A14:A15")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
        .Merge
    End With
    Rows("1:3").RowHeight = 15
    With Range("B1:B3").Font
        .Bold = True
        .Name = "Arial"
        .Size = 12
        .ColorIndex = 5
    End With
    With Range("H5,H6,H7,B16:B35")
        .Font.ColorIndex = 32
        .Locked = False
    End With
    With Range("A39:H40")
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .MergeCells = True
        .Merge
    End With
    Range("A1").Select
    Application.CommandBars("Control Toolbox").Visible = True
    ActiveSheet.DrawingObjects.Select
    Set Logo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=0.75, Top:=0.75, Width:=40, Height:=45)
    'Logo.Object.Picture = LoadPicture("C:\Users\MU\Pictures\excel_2003.bmp")
    With Logo.Object
        .Picture = Resim(URL1)
        .PictureAlignment = 2
        .PictureSizeMode = 1
    End With
    Application.CommandBars("Control Toolbox").Visible = False
    Set Logo = Nothing
    Rows("38:38").RowHeight = 15
    Rows("39:40").RowHeight = 24
    Range("H5").Select
    ActiveSheet.Protect
End Sub
Private Function Resim(URL) As Picture 'Picture load frome web address...

    On Error Resume Next
    CLSIDFromString StrPtr(ClsID), IPic(0)
    OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()

    ' On Error Resume Next
    ' Dim Eleman, No
    ' No = 1
    ' For Each Eleman In ThisWorkbook.VBProject.References
        ' Sheets(1).Cells(No, 1) = No & ") Name: "
        ' Sheets(1).Cells(No, 2) = Eleman.Name
        ' Sheets(1).Cells(No, 3) = ", Description: "
        ' Sheets(1).Cells(No, 4) = Eleman.Description
        ' Sheets(1).Cells(No, 5) = ", FullPath: "
        ' Sheets(1).Cells(No, 6) = Eleman.FullPath
        ' No = No + 1
    ' Next Eleman
'End Sub

Hiç yorum yok:

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