Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Aralık 2009 Perşembe

vsFlexArray Explorer [1]


'UserForm1

'A) Visual Basic For Application
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Forms 2.0 Object Library
'Windows Media Player
':-) VideoSoft vsFlex3 Controls ("c:\WINDOWS\system32\VSFLEX3.ocx")
'B) Addition Tools on UserForm1
'Frame1
'Frame1\Image1, Label1, Label2
'vsFlexArray1, Label3,CommandButton1
'Ülke Bayrakları : http://excelkodklavuzu.blogspot.com/2007/09/ulke-bayraklar-pbid-country-flags.html
Option Explicit
Dim i As Integer, ii As Integer
Dim Resim As String
Dim Bellek(1 To 12, 1 To 8)
Dim Eleman As Worksheet
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] vsFlexArray Explorer [1]."
Call BellekBilgisi
Call EkranDüzenle
Call vsFlexArray1_Kur
End Sub
Private Sub vsFlexArray1_SelChange()

On Error Resume Next
vsFlexArray1.EditCell

End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
Call SayfaDüzenle
For i = 1 To 12
Cells(i + 1, 1) = vsFlexArray1.TextMatrix((i - 1) * 4 + 1, 0)
Cells(i + 1, 2) = vsFlexArray1.TextMatrix((i - 1) * 4 + 1, 1)
Cells(i + 1, 3) = vsFlexArray1.TextMatrix((i - 1) * 4 + 1, 3)
Cells(i + 1, 4) = vsFlexArray1.ValueMatrix((i - 1) * 4 + 1, 5)
Cells(i + 1, 5) = vsFlexArray1.ValueMatrix((i - 1) * 4 + 2, 5)
Cells(i + 1, 6) = vsFlexArray1.ValueMatrix((i - 1) * 4 + 3, 5)
Cells(i + 1, 7) = vsFlexArray1.ValueMatrix((i - 1) * 4 + 4, 5)
Cells(i + 1, 8) = Bellek(i, 8)
Next i
End Sub
Sub vsFlexArray1_Kur() 'vsFlexArray1_Install

On Error Resume Next
With vsFlexArray1
.TextArray(5) = "Döviz Kurları"
For i = 1 To 4
.ColAlignment(i) = flexAlignCenterCenter
Next i
.TextStyleFixed = flexTextRaised
For i = 0 To 4
.TextMatrix(0, i) = "Döviz Cinsi"
Next i
.MergeRow(0) = True
.MergeCells = 1
For i = 1 To 12
.TextMatrix((i - 1) * 4 + 1, 0) = i
.TextMatrix((i - 1) * 4 + 2, 0) = i
.TextMatrix((i - 1) * 4 + 3, 0) = i
.TextMatrix((i - 1) * 4 + 4, 0) = i
.TextMatrix((i - 1) * 4 + 1, 1) = Sheets("Parite").Cells(i + 1, 2)
.TextMatrix((i - 1) * 4 + 2, 1) = Sheets("Parite").Cells(i + 1, 2)
.TextMatrix((i - 1) * 4 + 3, 1) = Sheets("Parite").Cells(i + 1, 2)
.TextMatrix((i - 1) * 4 + 4, 1) = Sheets("Parite").Cells(i + 1, 2)
.TextMatrix((i - 1) * 4 + 1, 2) = Application.WorksheetFunction.Rept(" ", i)
.TextMatrix((i - 1) * 4 + 2, 2) = Application.WorksheetFunction.Rept(" ", i)
.TextMatrix((i - 1) * 4 + 3, 2) = Application.WorksheetFunction.Rept(" ", i)
.TextMatrix((i - 1) * 4 + 4, 2) = Application.WorksheetFunction.Rept(" ", i)
.TextMatrix((i - 1) * 4 + 1, 3) = Sheets("Parite").Cells(i + 1, 3)
.TextMatrix((i - 1) * 4 + 2, 3) = Sheets("Parite").Cells(i + 1, 3)
.TextMatrix((i - 1) * 4 + 3, 3) = Sheets("Parite").Cells(i + 1, 3)
.TextMatrix((i - 1) * 4 + 4, 3) = Sheets("Parite").Cells(i + 1, 3)
.TextMatrix((i - 1) * 4 + 1, 4) = "Döviz Alış"
.TextMatrix((i - 1) * 4 + 2, 4) = "Döviz Satış"
.TextMatrix((i - 1) * 4 + 3, 4) = "Efektif Alış"
.TextMatrix((i - 1) * 4 + 4, 4) = "Efektif Satış"
.TextMatrix((i - 1) * 4 + 1, 5) = Sheets("Parite").Cells(i + 1, 4)
.TextMatrix((i - 1) * 4 + 2, 5) = Sheets("Parite").Cells(i + 1, 5)
.TextMatrix((i - 1) * 4 + 3, 5) = Sheets("Parite").Cells(i + 1, 6)
.TextMatrix((i - 1) * 4 + 4, 5) = Sheets("Parite").Cells(i + 1, 7)
Next i
For i = 0 To 4
.MergeCol(i) = True
.MergeCells = 1
Next i
.AutoSizeMode = flexAutoSizeColWidth
.AutoSize 0, 4, 0
For i = 1 To 12
.Row = (i - 1) * 4 + 1
.Col = 2
Resim = Sheets("Parite").Cells(i + 1, 8)
Set .CellPicture = LoadPicture(Resim)
.CellPictureAlignment = flexPicAlignStretch
Next i
.ExtendLastCol = True
End With
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 310 + 30 + 12 + 18 + 6 + 24 + 6
.Width = 366
.BackColor = &H80000014
With Frame1
.Caption = ""
.Left = -1
.Top = -1
.Height = 30
.Width = Me.Width + 12
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\ZarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
With Image1
.Left = 1.5
.Top = 1.5
.Height = 24
.Width = 24
.BorderColor = vbBlue
.BackStyle = fmBackStyleTransparent
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
End With
With Label1
.Left = 1.5 + 24 + 3
.Top = 1.5
.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue
End With
With Label2
.Left = 1.5 + 24 + 3
.Top = 13.5
.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue
End With
End With
With Label3
.Top = 30
.Left = 0
.Height = 12
.Width = Me.Width
.BackColor = vbWhite
.Caption = "Indicative Exchange Rates Announced at 15:30 on 12/18/2009 by the Central Bank of Turkey"
.ForeColor = vbBlue
.TextAlign = fmTextAlignCenter
End With
With vsFlexArray1
.Top = Label3.Top + Label3.Height
.Left = 0
.Height = 310
.Width = Me.Width
.Appearance = flex3D
.Cols = 6
.FixedCols = 5
.Rows = 1 + (12 * 4)
.FixedRows = 1
.ForeColor = vbBlue
End With
With CommandButton1
.Caption = "Excele Veri Aktar"
.Top = vsFlexArray1.Top + vsFlexArray1.Height + 6
.Left = 6
.Height = 18
.Width = Me.Width - .Left - 12
End With
End With
End Sub
Sub BellekBilgisi()

On Error Resume Next
Bellek(1, 1) = 1: Bellek(1, 2) = "ABD": Bellek(1, 3) = "ABD DOLARI": Bellek(1, 4) = 1.5111: Bellek(1, 5) = 1.5184: Bellek(1, 6) = 1.51: Bellek(1, 7) = 1.5207: Bellek(1, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\USD-ABD.jpg"
Bellek(2, 1) = 2: Bellek(2, 2) = "AUD": Bellek(2, 3) = "AVUSTRALYA DOLARI": Bellek(2, 4) = 1.3412: Bellek(2, 5) = 1.35: Bellek(2, 6) = 1.335: Bellek(2, 7) = 1.3581: Bellek(2, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\AUD-Australia.jpg"
Bellek(3, 1) = 3: Bellek(3, 2) = "DKK": Bellek(3, 3) = "DANİMARKA KRONU": Bellek(3, 4) = 0.29196: Bellek(3, 5) = 0.2934: Bellek(3, 6) = 0.29176: Bellek(3, 7) = 0.29407: Bellek(3, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\DKK-Denmark.jpg"
Bellek(4, 1) = 4: Bellek(4, 2) = "EUR": Bellek(4, 3) = "EURO": Bellek(4, 4) = 2.173: Bellek(4, 5) = 2.1835: Bellek(4, 6) = 2.1715: Bellek(4, 7) = 2.1868: Bellek(4, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\EUR-AvrupaBirliği.jpg"
Bellek(5, 1) = 5: Bellek(5, 2) = "GBP": Bellek(5, 3) = "İNGİLİZ STERLİNİ": Bellek(5, 4) = 2.4479: Bellek(5, 5) = 2.4607: Bellek(5, 6) = 2.4462: Bellek(5, 7) = 2.4644: Bellek(5, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\GBR-United-Kingdom.jpg"
Bellek(6, 1) = 6: Bellek(6, 2) = "CHF": Bellek(6, 3) = "İSVİÇRE FRANGI": Bellek(6, 4) = 1.4476: Bellek(6, 5) = 1.4569: Bellek(6, 6) = 1.4454: Bellek(6, 7) = 1.4591: Bellek(6, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\CHF-Switzerland.jpg"
Bellek(7, 1) = 7: Bellek(7, 2) = "SEK": Bellek(7, 3) = "İSVEÇ KRONU": Bellek(7, 4) = 0.20684: Bellek(7, 5) = 0.20899: Bellek(7, 6) = 0.2067: Bellek(7, 7) = 0.20947: Bellek(7, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\SEK-Sweden.jpg"
Bellek(8, 1) = 8: Bellek(8, 2) = "CAD": Bellek(8, 3) = "KANADA DOLARI": Bellek(8, 4) = 1.4171: Bellek(8, 5) = 1.4235: Bellek(8, 6) = 1.4119: Bellek(8, 7) = 1.4289: Bellek(8, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\CAD-Canada.jpg"
Bellek(9, 1) = 9: Bellek(9, 2) = "KWD": Bellek(9, 3) = "KUVEYT DİNARI": Bellek(9, 4) = 5.2328: Bellek(9, 5) = 5.3017: Bellek(9, 6) = 5.1543: Bellek(9, 7) = 5.3812: Bellek(9, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\KWD-Kuwait.jpg"
Bellek(10, 1) = 10: Bellek(10, 2) = "NOK": Bellek(10, 3) = "NORVEÇ KRONU": Bellek(10, 4) = 0.25821: Bellek(10, 5) = 0.25995: Bellek(10, 6) = 0.25803: Bellek(10, 7) = 0.26055: Bellek(10, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\NOK-Norway.jpg"
Bellek(11, 1) = 11: Bellek(11, 2) = "SAR": Bellek(11, 3) = "SUUDİ ARABİSTAN RİYALİ": Bellek(11, 4) = 0.40408: Bellek(11, 5) = 0.40481: Bellek(11, 6) = 0.40105: Bellek(11, 7) = 0.40785: Bellek(11, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\SAR-Saudi-Arabia.jpg"
Bellek(12, 1) = 12: Bellek(12, 2) = "JPY": Bellek(12, 3) = "100 JAPON YENİ": Bellek(12, 4) = 1.6709: Bellek(12, 5) = 1.682: Bellek(12, 6) = 1.6647: Bellek(12, 7) = 1.6884: Bellek(12, 8) = "C:\Documents and Settings\PC\Desktop\BLOGSPOT\Bayraklar\JPY-Japan.jpg"
Call SayfaDüzenle
For i = 1 To 12
For ii = 1 To 8
Cells(i + 1, ii) = Bellek(i, ii)
Next ii
Next i
End Sub
Sub SayfaDüzenle()

On Error Resume Next
For Each Eleman In ThisWorkbook.Sheets
If Eleman.Name = "Parite" Then GoTo Mevcut
Next Eleman
ThisWorkbook.Worksheets.Add Sheets(1)
Application.ActiveSheet.Name = "Parite"
Mevcut:
Sheets("Parite").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Range("A1").FormulaR1C1 = "No"
Range("B1").FormulaR1C1 = "Döviz"
Range("C1").FormulaR1C1 = "Döviz Adı"
Range("D1").FormulaR1C1 = "Döviz Alış"
Range("E1").FormulaR1C1 = "Döviz Satış"
Range("F1").FormulaR1C1 = "Efektif Alış"
Range("G1").FormulaR1C1 = "Efektif Satış"
Range("H1").FormulaR1C1 = "Icon Dosya Adı"
With Range("A1:H1")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.ColorIndex = 2
With .Interior
.ColorIndex = 5
.Pattern = xlSolid
End With
End With
Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 8
Columns("C:C").ColumnWidth = 24
Columns("D:D").ColumnWidth = 12
Columns("E:E").ColumnWidth = 12
Columns("F:F").ColumnWidth = 12
Columns("G:G").olumnWidth = 12
Columns("H:H").ColumnWidth = 74
End Sub

1 yorum:

rose dedi ki...

I recently came across your blog and have been reading along. I thought I would leave my first comment. I don't know what to say except that I have enjoyed reading. Nice blog. I will keep visiting this blog very often.

Lucy

http://forextradin-g.net

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