Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ekim 2012 Cumartesi

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



'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 Sayfa As Worksheet
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
Application.DisplayAlerts = False
Sheets("Gelir").Select
If VBA.Err.Number > 0 Then
ThisWorkbook.Worksheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Gelir"
VBA.Err.Clear
End If
Sheets("Vergi").Select
If VBA.Err.Number > 0 Then
ThisWorkbook.Worksheets.Add After:=Sheets(1)
ActiveSheet.Name = "Vergi"
VBA.Err.Clear
End If
Sheets("IRR").Select
If VBA.Err.Number > 0 Then
ThisWorkbook.Worksheets.Add After:=Sheets(2)
ActiveSheet.Name = "IRR"
VBA.Err.Clear
End If
Call Vergi_Kur
Call Vergi_Kur
Application.DisplayAlerts = True
With Application
.Iteration = True
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.Calculate
End Sub
Private Sub Vergi_Kur()
On Error Resume Next
Sheets("Vergi").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"
Call Gelir_Tablo
Range("B16:B35").FormulaR1C1 = "=Gelir!R[-9]C[6]"
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")
.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
Selection.Delete
Set Logo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=0.75, Top:=0.75, Width:=45, 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
Range("H5").Select
ActiveSheet.Protect
Call IRR_Kur
End Sub
Private Sub Gelir_Tablo()
On Error Resume Next
Sheets("Gelir").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 = "PROJE YÜKÜMLÜLÜKLERİNİ KARŞILAYAN HASILAT HESABI [TL]"
Range("A5").FormulaR1C1 = "Yıllar"
For hSingle = 1 To 20
Range("A7:A26").Cells(hSingle, 1).FormulaR1C1 = hSingle
Next hSingle
Range("A27").FormulaR1C1 = "Toplam"
Range("B5").FormulaR1C1 = "Proje Gelirleri"
Range("B6").FormulaR1C1 = "A=B+D+E+F+H+I"
Range("B7:B26").FormulaR1C1 = "=RC[1]+RC[3]+RC[4]+RC[5]+RC[7]+RC[8]"
Range("B27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("C5").FormulaR1C1 = "Üretim Giderleri"
Range("C6").FormulaR1C1 = "B"
Range("C7:C26").FormulaR1C1 = "2600000"
Range("C27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("D5").FormulaR1C1 = "Amortisman ve Tükenme Payları"
Range("D6").FormulaR1C1 = "C"
Range("D7:D26").FormulaR1C1 = "=Vergi!R5C8/20"
Range("D27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("E5").FormulaR1C1 = "Yönetim Giderleri"
Range("E6").FormulaR1C1 = "D"
Range("E7:E26").FormulaR1C1 = "385000"
Range("E27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("F5").FormulaR1C1 = "Yatırıma Ait Kredi Faizleri"
Range("F6").FormulaR1C1 = "E"
Range("F7").FormulaR1C1 = "=Vergi!R5C8*0.75*0.12"
Range("F8").FormulaR1C1 = "=(Vergi!R5C8*0.75-R[-1]C[1])*0.12"
Range("F9").FormulaR1C1 = "=(Vergi!R5C8*0.75-R[-2]C[1]-R[-1]C[1])*0.12"
Range("F10").FormulaR1C1 = "=(Vergi!R5C8*0.75-R[-3]C[1]-R[-2]C[1]-R[-1]C[1])*0.12"
Range("F11").FormulaR1C1 = "=(Vergi!R5C8*0.75-R[-4]C[1]-R[-3]C[1]-R[-2]C[1]-R[-1]C[1])*0.12"
Range("F12").FormulaR1C1 = "=(Vergi!R5C8*0.75-R[-5]C[1]-R[-4]C[1]-R[-3]C[1]-R[-2]C[1]-R[-1]C[1])*0.12"
Range("F13:F26").FormulaR1C1 = ""
Range("F27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("G5").FormulaR1C1 = "Kredi Anapara Taksitleri"
Range("G6").FormulaR1C1 = "F"
Range("G7:G11").FormulaR1C1 = "=Vergi!R5C8*0.75/5"
Range("G12:G26").FormulaR1C1 = ""
Range("G27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("H5").FormulaR1C1 = "Vergi Öncesi Kar/Zarar"
Range("H6").FormulaR1C1 = "G=A-B-C-D-E"
Range("H7:H26").FormulaR1C1 = "=RC[-6]-RC[-5]-RC[-4]-RC[-3]-RC[-2]"
Range("H27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("I5").FormulaR1C1 = "Toplam Kurumlar Vergisi"
Range("I6").FormulaR1C1 = "H=[o]"
Range("I7:I26").FormulaR1C1 = "=Vergi!R[9]C[-1]"
Range("I27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("J5").FormulaR1C1 = "Makul Temettü"
Range("J6").FormulaR1C1 = "I=C"
Range("J7:J26").FormulaR1C1 = "=RC[-6]"
Range("J27").FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Rows("4:4").RowHeight = 6
Columns("A:A").ColumnWidth = 8
Columns("B:J").ColumnWidth = 12
Range("A1:J27").Font.Size = 8
Range("B7:J27").NumberFormat = "#,##0.00"
With Range("B1:B3").Font
.Name = "Arial"
.Bold = True
.Size = 12
.ColorIndex = 5
End With
Rows("1:3").RowHeight = 15.75
With Range("A5:A6")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.ShrinkToFit = True
.MergeCells = True
.Merge
End With
With Range("B5:J6")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.IndentLevel = 0
.ShrinkToFit = True
End With
Range("A7:A27").HorizontalAlignment = xlCenter
With Range("A5:J27,A5:A27,H5:J27,A5:J6,A27:J27")
.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("C7:C26,E7:E26")
.Locked = False
.Font.ColorIndex = 32
End With
Range("A1").Select
Application.CommandBars("Control Toolbox").Visible = True
ActiveSheet.DrawingObjects.Select
Selection.Delete
Set Logo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=0.75, Top:=0.75, Width:=45, 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
Range("H5").Select
ActiveSheet.Protect
Sheets("Vergi").Select
End Sub
Private Sub IRR_Kur()
On Error Resume Next
Sheets("IRR").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 = "ÖDENMİŞ SERMAYENİN [TL] İÇ VERİMLİLİK ORANI"
Range("A5").FormulaR1C1 = "Yıllar"
Range("A6").FormulaR1C1 = ""
Range("A7").FormulaR1C1 = "1"
Range("A8").FormulaR1C1 = "2"
For hSingle = 1 To 20
Range("A9:A28").Cells(hSingle, 1).FormulaR1C1 = hSingle
Next hSingle
Range("A29").FormulaR1C1 = "Toplam"
Range("B5").FormulaR1C1 = "Sermaye Nakit Çıkışları"
Range("B6").FormulaR1C1 = "A"
Range("B7").FormulaR1C1 = "=Vergi!R5C8*0.25*0.4"
Range("B8").FormulaR1C1 = "=Vergi!R5C8*0.25*0.6"
Range("B9:B28").FormulaR1C1 = ""
Range("B29").FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
Range("C5").FormulaR1C1 = "Makul Temettü Nakit Girişleri"
Range("C6").FormulaR1C1 = "B"
Range("C7").FormulaR1C1 = ""
Range("C8").FormulaR1C1 = ""
Range("C9:C28").FormulaR1C1 = "=Gelir!R[-2]C[7]"
Range("C29").FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
Range("D5").FormulaR1C1 = "Net Nakit Girişleri"
Range("D6").FormulaR1C1 = "C=B-A"
Range("D7:D28").FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("D29").FormulaR1C1 = "=SUM(R[-22]C:R[-1]C)"
Range("E5").FormulaR1C1 = "Sermayenin İç Verim Oranı [IRR]"
Range("E6").FormulaR1C1 = "D=IRR"
Range("E7:E28").FormulaR1C1 = "=IRR(R7C4:RC[-1])"
Range("E29").FormulaR1C1 = "=R[-1]C"
With Range("B1:B3").Font
.Name = "Arial"
.Bold = True
.Size = 12
.ColorIndex = 5
End With
Rows("1:3").RowHeight = 15.75
Range("B7:D29").NumberFormat = "#,##0.00"
Range("E7:E29").NumberFormat = "0.00%"
Range("A5:E29").Font.Size = 8
With Range("A5:A6")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.ShrinkToFit = True
.MergeCells = True
.Merge
End With
With Range("B5:E6")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.IndentLevel = 0
.ShrinkToFit = True
End With
Range("A7:A29").HorizontalAlignment = xlCenter
Columns("A:A").ColumnWidth = 8
Columns("B:E").ColumnWidth = 12
Rows("4:4").RowHeight = 6
With Range("A5:E29,A5:A29,A5:E8,A5:E6,A29:E29")
.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
Range("A1").Select
Application.CommandBars("Control Toolbox").Visible = True
ActiveSheet.DrawingObjects.Select
Selection.Delete
Set Logo = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, Left:=0.75, Top:=0.75, Width:=45, 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
Range("E6").Select
ActiveSheet.Protect
Sheets("Gelir").Select
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