Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

25 Kasım 2010 Perşembe

RedrawWindow


'Workbook Module

'Windows XP® Office 2003® Normal Referance List

'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\STDOLE2.TLB
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL

Private Sub Workbook_Open()

On Error Resume Next
Saat_Göster Hedef_Hücre:=Range("F12")

End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

On Error Resume Next
KillTimer 0, Sayaç
Sayaç = 0

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

On Error Resume Next
InvalidateRect 0, 0, 0
KillTimer 0, Sayaç
Sayaç = 0

End Sub

'Module1

Option Explicit
Private Type POSITION

X As Long
Y As Long

End Type
Private tP As POSITION, tPt As POSITION
Private Type LOCATION

Left As Long
Top As Long
Right As Long
Bottom As Long

End Type
Private tL As LOCATION
Private Type LOGFONT

fHeight As Long
fWidth As Long
fEscapement As Long
fOrientation As Long
fWeight As Long
fItalic As Byte
fUnderline As Byte
fStrikeOut As Byte
fCharSet As Byte
fOutPrecision As Byte
fClipPrecision As Byte
fQuality As Byte
fPitchAndFamily As Byte
fFaceName As String * 72

End Type
Private tF As LOGFONT
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As LOCATION, ByVal wFormat As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POSITION) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, ByVal lprcUpdate As Long, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As LOCATION, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private i As Long
Private Const PI As Single = 3.14159265358979
Private NWP As Range
Private Sayaç As Long
Private X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, A2 As Long, B2 As Long
Private Nesne As Long
Private Kadran As Long
Private NF As Long
Private mX, mY As Double
Public Sub Saat_Göster(Hedef_Hücre As Range)

If Sayaç = 0 Then

Set NWP = ActiveWindow.VisibleRange.Cells(1, 1)
If Union(Hedef_Hücre, ActiveWindow.VisibleRange).Address <> ActiveWindow.VisibleRange.Address Then

GoTo Hata:

End If
tP = Noktalama(Hedef_Hücre)
Sayaç = SetTimer(0, 0, 1000, AddressOf Saat_Kur)

End If
Exit Sub
Hata:
MsgBox "Hedef hücre görünür değil...", vbCritical

End Sub
Private Sub Saat_Kur()

On Error Resume Next
If GetForegroundWindow = FindWindow("XLMAIN", Application.Caption) Then

If ActiveWindow.VisibleRange.Cells(1, 1).Address <> NWP.Address Then

InvalidateRect 0, 0, 0
DoEvents

End If
Call Saat_Yapma
Call Saat_Ayarlama

End If

End Sub
Private Sub Saat_Yapma()

On Error Resume Next
X1 = tP.X: Y1 = tP.Y
Nesne = GetDC(0)
SetBkMode Nesne, 1
Call Alfabe(Nesne, True)
For Kadran = 0 To 359

For i = 1 To 18

X2 = (64 + i) * Sin(Kadran * PI / 180)
Y2 = (64 + i) * Cos(Kadran * PI / 180)
SetPixel Nesne, X2 + X1, Y2 + Y1, VBA.RGB(0, 0, 255)

Next i
For i = 1 To 12

X2 = (64 + i) * Sin(Kadran * PI / 180)
Y2 = (64 + i) * Cos(Kadran * PI / 180)
SetPixel Nesne, X2 + X1, Y2 + Y1, VBA.RGB(0, 140, 255)

Next i
A2 = 60 * 80 / 100 * Sin(Kadran * PI / 180)
B2 = 60 * 80 / 100 * Cos(Kadran * PI / 180)
SetRect tL, A2 + X1 - 5, B2 + Y1 - 5, A2 + X1 + 5, B2 + Y1 + 5
Select Case Kadran

Case Is = 0: DrawText Nesne, "6", 1, tL, &H1
Case Is = 30: DrawText Nesne, "5", 1, tL, &H1
Case Is = 60: DrawText Nesne, "4", 1, tL, &H1
Case Is = 90: DrawText Nesne, "3", 1, tL, &H1
Case Is = 120: DrawText Nesne, "2", 1, tL, &H1
Case Is = 150: DrawText Nesne, "1", 1, tL, &H1
Case Is = 180: DrawText Nesne, "12", 2, tL, &H1
Case Is = 210: DrawText Nesne, "11", 2, tL, &H1
Case Is = 240: DrawText Nesne, "10", 2, tL, &H1
Case Is = 270: DrawText Nesne, "9", 1, tL, &H1
Case Is = 300: DrawText Nesne, "8", 1, tL, &H1
Case Is = 330: DrawText Nesne, "7", 1, tL, &H1

End Select

Next Kadran

End Sub
Private Sub Saat_Ayarlama()

On Error Resume Next
RedrawWindow 0, 0, CreateEllipticRgn(X1 - 60 * 70 / 100, Y1 - 60 * 70 / 100, X1 + 60 * 70 / 100, Y1 + 60 * 70 / 100), &H1 + &H80
DoEvents
MoveToEx Nesne, X1, Y1, tPt 'Saniye
DeleteObject SelectObject(Nesne, CreatePen(0, 1, vbRed))
LineTo Nesne, X1 + ((60 * 70 / 100) * 0.85 * Sin(VBA.Second(Time) * (2 * PI / 60))), Y1 - ((60 * 70 / 100) * 0.85 * Cos(VBA.Second(Time) * (2 * PI / 60)))
MoveToEx Nesne, X1, Y1, tPt 'Dakika
DeleteObject SelectObject(Nesne, CreatePen(0, 2, vbBlack))
LineTo Nesne, X1 + (60 * 70 / 100) * Sin((VBA.Minute(Time) + (VBA.Second(Time) / 60)) * (2 * PI / 60)) * 0.8, Y1 - (60 * 70 / 100) * Cos((VBA.Minute(Time) + (VBA.Second(Time) / 60)) * (2 * PI / 60)) * 0.8
MoveToEx Nesne, X1, Y1, tPt 'Saat
DeleteObject SelectObject(Nesne, CreatePen(0, 4, vbBlack))
LineTo Nesne, X1 + (60 * 80 / 100) * Sin((VBA.Hour(Time) + (VBA.Minute(Time) / 60)) * (2 * PI / 12)) * 0.5, Y1 - (60 * 80 / 100) * Cos((VBA.Hour(Time) + (VBA.Minute(Time) / 60)) * (2 * PI / 12)) * 0.5
Set NWP = ActiveWindow.VisibleRange.Cells(1, 1)
ReleaseDC 0, Nesne

End Sub
Private Function Noktalama(Hücre As Range) As POSITION

On Error Resume Next
Nesne = GetDC(0)
mX = Hücre.Left + (Hücre.Width / 2)
mY = Hücre.Top + (Hücre.Height / 2)
With Noktalama

.X = ActiveWindow.PointsToScreenPixelsX((mX) * (GetDeviceCaps(Nesne, 88) / 72 * ActiveWindow.Zoom / 100))
.Y = ActiveWindow.PointsToScreenPixelsY((mY) * (GetDeviceCaps(Nesne, 90) / 72 * ActiveWindow.Zoom / 100))

End With
ReleaseDC 0, Nesne

End Function
Private Sub Alfabe(Seçilen_Nesne As Long, Optional Koyuluk As Boolean)

On Error Resume Next
With tF

.fFaceName = "Arial" & VBA.Chr$(0)
.fHeight = 12
.fWidth = 6
.fWeight = VBA.IIf(Koyuluk, 100, 100)

End With
NF = CreateFontIndirect(tF)
DeleteObject SelectObject(Seçilen_Nesne, NF)

End Sub
'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

10 Kasım 2010 Çarşamba

Text Orientation by The SetWorldTransform Function




'UserForm1

'A) VBProject References List

'Name: VBA, Description: Visual Basic For Applications
'Name: Excel, Description: Microsoft Excel 11.0 Object Library
'Name: stdole, Description: OLE Automation
'Name: Office, Description: Microsoft Office 11.0 Object Library
'Name: MSForms, Description: Microsoft Forms 2.0 Object Library
'B) Addition Tools on UserForm1
'Image1, label1, Label2
Option Explicit
Private Declare Function GetDC Lib "User32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "User32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetGraphicsMode Lib "GDI32.dll" (ByVal hDC As Long, ByVal iMode As Long) As Long
Private Declare Function GetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
Private Declare Function SetWorldTransform Lib "GDI32.dll" (ByVal hDC As Long, ByRef lpXform As XForm) As Long
Private Declare Function TextOut Lib "GDI32.dll" Alias "TextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Type XForm

Prm1 As Single 'Text right to left and chr width
Prm2 As Single 'Text horizontal orientation degrees
Prm3 As Single 'Text vertical orientation degrees
Prm4 As Single
'Text chr height
Prm5 As Single 'X preposition
Prm6 As Single
'Y preposition
End Type
Private PlpXform As XForm, OlpXform As XForm
Private OldGM As Long
Private DrawDC As Long
Private Const DemoText As String = "[PBİD®] Program - Bütçeleme & İzleme - Değerlendirme"
'PBİD: Program - Budgeting & Monitoring – Evaluation

Private Apsis As Double, Ordinat As Double, En As Double, Boy As Double
Private i As Single, ii As Single
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Text Orientation by The SetWorldTransform Function"
Call EkranDüzenle
End Sub
Private Sub UserForm_Click()

On Error Resume Next
For i = -6 To 6 Step 0.1
Me.Repaint
Call TextOrientation(i, 0.001, 0, 6, Apsis, Ordinat)
For ii = 1 To 600
DoEvents
Next ii
Next i
Me.Repaint
Call TextOrientation(-1, 0.001, 0, 6, Apsis, Ordinat)
DoEvents
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

On Error Resume Next
Me.Repaint
Apsis = VBA.Round(X / 0.748, 0)
Ordinat = VBA.Round(Y / 0.748, 0)
Call TextOrientation(1, 0.001, 0, 6, Apsis, Ordinat)
DoEvents
End Sub
Private Sub TextOrientation(A, B, C, D, E, F)

On Error Resume Next
DrawDC = GetDC(FindWindow(vbNullString, Me.Caption))
OldGM = SetGraphicsMode(DrawDC, 2)
Call GetWorldTransform(DrawDC, OlpXform)
With PlpXform
.Prm1 = A
.Prm2 = B
.Prm3 = C
.Prm4 = D
.Prm5 = E
.Prm6 = F
End With
If (SetWorldTransform(DrawDC, PlpXform)) Then
Call TextOut(DrawDC, 0, 0, DemoText, Len(DemoText))
Call SetWorldTransform(DrawDC, OlpXform)
End If
Call SetGraphicsMode(DrawDC, OldGM)
Call ReleaseDC(FindWindow(vbNullString, Me.Caption), DrawDC)
End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 300
.Width = 480
'.Picture = LoadPicture("C:\Documents and Settings\Administrator\Belgelerim\Mustafa ULUSARAÇ\VectorBackround.jpg")
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
.BackColor = vbWhite
With Image1
.Left = 6
.Top = 6
.Height = 24
.Width = 24
.BorderColor = vbWhite
.BorderStyle = fmBorderStyleSingle
.BackStyle = fmBackStyleTransparent
'.Picture = LoadPicture("C:\Documents and Settings\Administrator\Belgelerim\Mustafa ULUSARAÇ\PBİD.ico")
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Top = 6
.Left = 36
.Height = 12
.Width = 228
.AutoSize = False
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.Caption = "Mustafa ULUSARAÇ"
.Font.Bold = True
.ForeColor = vbBlue
.SpecialEffect = fmSpecialEffectFlat
.TextAlign = fmTextAlignLeft
End With
With Label2
.Top = 18
.Left = 36
.Height = 12
.Width = 228
.AutoSize = False
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.Caption = "01ulusarac@superonline.com"
.Font.Bold = True
.ForeColor = vbBlue
.SpecialEffect = fmSpecialEffectFlat
.TextAlign = fmTextAlignLeft
End With
End With
End Sub


'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public 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
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
'It may take a few seconds, please wait.

Public URL As String
Public Const URL1 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg"
'Microsoft Office Excel® Kod Kılavuzu [UserFormBackround]

Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
Sub FormAç() 'Open UserForm
On Error Resume Next
UserForm1.Show 0
End Sub
Public 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 ReferecesList()

' Dim Eleman, ElemanNo
' Sheets("ReferencesList").Select
' ElemanNo = 1
' For Each Eleman In ThisWorkbook.VBProject.References
' Cells(ElemanNo, 1) = "Name: "
' Cells(ElemanNo, 2) = Eleman.Name
' Cells(ElemanNo, 3) = ", Description: "
' Cells(ElemanNo, 4) = Eleman.Description
' Cells(ElemanNo, 5) = ", FullPath: "
' Cells(ElemanNo, 6) = Eleman.FullPath
' Cells(ElemanNo, 7) = ", Guid: "
' Cells(ElemanNo, 8) = Eleman.GUID
' Cells(ElemanNo, 9) = ", Major: "
' Cells(ElemanNo, 10) = Eleman.major
' Cells(ElemanNo, 11) = ", Minor: "
' Cells(ElemanNo, 12) = Eleman.minor
' ElemanNo = ElemanNo + 1
' Next Eleman
'End Sub

4 Kasım 2010 Perşembe

Bring Comma-Separated Variables (csv) Data From Internet




'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'A1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'A2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'A3) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\STDOLE2.TLB
'A4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'A5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'A6) Name: MSComCtl2, Description: Microsoft Windows Common Controls-2 6.0 (SP4), FullPath: C:\WINDOWS\system32\MSCOMCT2.OCX [Picture: 1]
'A7) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX [Picture: 2]

'B) UserForm1'e Eklenen Araçlar (Add Tools)

'B1) Image1, Label1, Label2
'B2) Label3, DTPicker1 [Picture: 1]
'B3) Label4, DTPicker2 [Picture: 1]
'B4) Listview1 [Picture: 2]
'B5) ComboBox1, CommandButton1

Private No As Double, Adet As Double
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Bring Comma-Separated Variables (csv) Data From Internet"
Call Ekran_Düzenle

End Sub
Private Sub CommandButton1_Click()

On Error Resume Next
If ComboBox1.ListIndex > -1 Then Call Veri_Getir

End Sub
Private Sub Ekran_Düzenle()

On Error Resume Next
With Me

.Height = 300
.Width = 401
.BackColor = VBA.vbWhite
.Picture = Resim(URL1)
'.Picture = LoadPicture("C:\...\*.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1

.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = Resim(URL2)
'.Picture = LoadPicture("C:\...\*.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
With Label3

.Caption = " " & "Google MKB Fiyat Başlama Tarihi [Stock Start Date of Historical Prices]"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 36
.Height = 18
.Width = 306
.Font.Bold = False
.ForeColor = &H808000

End With
With DTPicker1

.Left = 318
.Top = 36
.Height = 18
.Width = 72
.Value = "01/01/2009"

End With
With Label4

.Caption = " " & "Google MKB Fiyat Bitiş Tarihi [Stock End Date of Historical Prices]"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectEtched
.Left = 6
.Top = 60
.Height = 18
.Width = 306
.Font.Bold = False
.ForeColor = &H808000

End With
With DTPicker2

.Left = 318
.Top = 60
.Height = 18
.Width = 72
.Value = VBA.Now

End With
With ListView1

.Left = 6
.Top = 84
.Height = 162
.Width = 384
.FullRowSelect = True
.Gridlines = True
.HideColumnHeaders = False
.MultiSelect = False
.TextBackground = lvwOpaque
.View = lvwReport
.Appearance = cc3D
.BorderStyle = ccNone
.FlatScrollBar = False
.LabelEdit = lvwManual
.BackColor = vbWhite
.ColumnHeaders.Add 1, "Date", "Date", 48, 0
.ColumnHeaders.Add 2, "Open", "Open", 64, 1
.ColumnHeaders.Add 3, "Hight", "Hight", 46, 1
.ColumnHeaders.Add 4, "Low", "Low", 64, 1
.ColumnHeaders.Add 5, "Close", "Close", 64, 1
.ColumnHeaders.Add 6, "Volume", "Volume", 84, 1

End With
With ComboBox1

.Left = 6
.Top = 252
.Height = 18
.Width = 282
.ColumnCount = 2
.ColumnWidths = "48;120"
Call Stock_Listele
.ListIndex = 85

End With
With CommandButton1

.Top = 252
.Left = 294
.Height = 18
.Width = 96
.Caption = "Bring the data"
.Font.Bold = True
.ForeColor = &H808000

End With

End With

End Sub
Sub Veri_Getir() 'Get URL_csv Data

On Error Resume Next
Dim SDay As Double, SMonth As Double, SYear As Double
Dim URL As String, SD As String, ED As String, POSITION As String, DATAPATH As String
Cells.Select
Selection.Delete Shift:=xlUp
URL = "URL;http://www.google.com/finance/historical?q="
SDay = VBA.Day(DTPicker1.Value)
SMonth = VBA.Month(DTPicker1.Value)
SYear = VBA.Year(DTPicker1.Value)
SD = VBA.Switch(SMonth = 1, "January", SMonth = 2, "February", SMonth = 3, "March", SMonth = 4, "April", SMonth = 5, "May", SMonth = 6, "June", SMonth = 7, "July", SMonth = 8, "August", SMonth = 9, "September", SMonth = 10, "October", SMonth = 11, "November", SMonth = 12, "December") & "+" & SDay & "+" & SYear
SDay = VBA.Day(DTPicker2.Value)
SMonth = VBA.Month(DTPicker2.Value)
SYear = VBA.Year(DTPicker2.Value)
ED = VBA.Switch(SMonth = 1, "January", SMonth = 2, "February", SMonth = 3, "March", SMonth = 4, "April", SMonth = 5, "May", SMonth = 6, "June", SMonth = 7, "July", SMonth = 8, "August", SMonth = 9, "September", SMonth = 10, "October", SMonth = 11, "November", SMonth = 12, "December") & "+" & SDay & "+" & SYear
POSITION = ComboBox1.Value
DATAPATH = URL & POSITION & "&startdate=" & SD & "&enddate=" & ED & "&output=csv"
With ActiveSheet.QueryTables.Add(Connection:=DATAPATH, Destination:=Range("A1"))

.Name = "XOM&data=csv_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False

End With
With Range(Range("A1"), Range("A1").End(xlDown))

.Replace What:=",", Replacement:="_", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="_", FieldInfo:=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True

End With
Range("A1").FormulaR1C1 = "Date"
Range(Range("B1:F1"), Range("B1:F1").End(xlDown)).NumberFormat = "#,##0.00"
Columns("A:F").ColumnWidth = 12
Columns("F:F").ColumnWidth = 14
With Range("A1:F1")

.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2

End With
[A1].Select
Call Veri_Listele

End Sub
Private Sub Veri_Listele() 'Listview write...

On Error Resume Next
Adet = Application.WorksheetFunction.Count(ActiveSheet.Range("A2:A65536"))
With ListView1

.ListItems.Clear
If Adet > 0 Then

For No = 1 To (Adet - 1)

.ListItems.Add , "Key" & No, ActiveSheet.Cells(No + 2, 1).Value
.ListItems(No).ListSubItems.Add 1, No & "SKey1", VBA.Format(ActiveSheet.Cells(No + 1, 2).Value, "#,##0.00")
.ListItems(No).ListSubItems.Add 2, No & "SKey2", VBA.Format(ActiveSheet.Cells(No + 1, 3).Value, "#,##0.00")
.ListItems(No).ListSubItems.Add 3, No & "SKey3", VBA.Format(ActiveSheet.Cells(No + 1, 4).Value, "#,##0.00")
.ListItems(No).ListSubItems.Add 4, No & "SKey4", VBA.Format(ActiveSheet.Cells(No + 1, 5).Value, "#,##0.00")
.ListItems(No).ListSubItems.Add 5, No & "SKey5", VBA.Format(ActiveSheet.Cells(No + 1, 6).Value, "#,##0.00")

Next No

End If

End With

End Sub
Private Sub Stock_Listele() 'Sample stock list

On Error Resume Next
ComboBox1.AddItem "35G": ComboBox1.List(0, 1) = "Genpact Ltd."
ComboBox1.AddItem "A": ComboBox1.List(1, 1) = "Agilent Technologies Inc."
ComboBox1.AddItem "ACN": ComboBox1.List(2, 1) = "Accenture Plc"
ComboBox1.AddItem "ADC": ComboBox1.List(3, 1) = "Agree Realty Corporation"
ComboBox1.AddItem "ADS": ComboBox1.List(4, 1) = "Alliance Data Systems ..."
ComboBox1.AddItem "AEE": ComboBox1.List(5, 1) = "Ameren Corporation"
ComboBox1.AddItem "AFG": ComboBox1.List(6, 1) = "American Financial Group"
ComboBox1.AddItem "AFSI": ComboBox1.List(7, 1) = "Amtrust Financial Serv..."
ComboBox1.AddItem "AIG": ComboBox1.List(8, 1) = "American Intl. Group, ..."
ComboBox1.AddItem "AKS": ComboBox1.List(9, 1) = "AK Steel Holding Corp."
ComboBox1.AddItem "AMSWA": ComboBox1.List(10, 1) = "American Software, Inc."
ComboBox1.AddItem "AR": ComboBox1.List(11, 1) = "Argonaut Gold Ltd."
ComboBox1.AddItem "ATEA": ComboBox1.List(12, 1) = "Astea International Inc."
ComboBox1.AddItem "AUX": ComboBox1.List(13, 1) = "AUXILIUM Kancelaria Re..."
ComboBox1.AddItem "AXP": ComboBox1.List(14, 1) = "American Express Company"
ComboBox1.AddItem "AXP": ComboBox1.List(15, 1) = "American Express Company"
ComboBox1.AddItem "B": ComboBox1.List(16, 1) = "Barnes Group Inc."
ComboBox1.AddItem "BAC": ComboBox1.List(17, 1) = "Bank of America Corp."
ComboBox1.AddItem "BCS": ComboBox1.List(18, 1) = "Barclays PLC (ADR)"
ComboBox1.AddItem "BKH": ComboBox1.List(19, 1) = "Black Hills Corporation"
ComboBox1.AddItem "BONT": ComboBox1.List(20, 1) = "The Bon-Ton Stores, Inc."
ComboBox1.AddItem "BP": ComboBox1.List(21, 1) = "BP plc (ADR)"
ComboBox1.AddItem "BSK": ComboBox1.List(22, 1) = "Blue Sky Uranium Corp."
ComboBox1.AddItem "BXG": ComboBox1.List(23, 1) = "Bluegreen Corporation"
ComboBox1.AddItem "C": ComboBox1.List(24, 1) = "Citigroup Inc."
ComboBox1.AddItem "CAG": ComboBox1.List(25, 1) = "ConAgra Foods, Inc."
ComboBox1.AddItem "CAR": ComboBox1.List(26, 1) = "Avis Budget Group Inc."
ComboBox1.AddItem "CB": ComboBox1.List(27, 1) = "The Chubb Corporation"
ComboBox1.AddItem "CBB": ComboBox1.List(28, 1) = "Cincinnati Bell Inc."
ComboBox1.AddItem "CBEY": ComboBox1.List(29, 1) = "Cbeyond, Inc."
ComboBox1.AddItem "CBZ": ComboBox1.List(30, 1) = "CBIZ, Inc."
ComboBox1.AddItem "CCO": ComboBox1.List(31, 1) = "Cameco Corporation"
ComboBox1.AddItem "CCRT": ComboBox1.List(32, 1) = "CompuCredit Holdings Corp"
ComboBox1.AddItem "CDCS": ComboBox1.List(33, 1) = "CDC Software Corp"
ComboBox1.AddItem "CDN": ComboBox1.List(34, 1) = "CanaDream Corporation"
ComboBox1.AddItem "CDR": ComboBox1.List(35, 1) = "Cedar Shopping Centers..."
ComboBox1.AddItem "CGI": ComboBox1.List(36, 1) = "Celadon Group, Inc."
ComboBox1.AddItem "CHG": ComboBox1.List(37, 1) = "CH Energy Group, Inc."
ComboBox1.AddItem "CISXF": ComboBox1.List(38, 1) = "China Steel Corporation"
ComboBox1.AddItem "CKG": ComboBox1.List(39, 1) = "Chesapeake Gold Corp."
ComboBox1.AddItem "CLWR": ComboBox1.List(40, 1) = "Clearwire Corporation"
ComboBox1.AddItem "CLZ": ComboBox1.List(41, 1) = "Canasil Resources Inc."
ComboBox1.AddItem "CLZ": ComboBox1.List(42, 1) = "Canasil Resources Inc."
ComboBox1.AddItem "CMJ": ComboBox1.List(43, 1) = "Colombian Mines Corp."
ComboBox1.AddItem "CMS": ComboBox1.List(44, 1) = "CMS Energy Corporation"
ComboBox1.AddItem "CNA": ComboBox1.List(45, 1) = "CNA Financial Corporation"
ComboBox1.AddItem "CNP": ComboBox1.List(46, 1) = "CenterPoint Energy, Inc."
ComboBox1.AddItem "COP": ComboBox1.List(47, 1) = "ConocoPhillips"
ComboBox1.AddItem "CRM": ComboBox1.List(48, 1) = "salesforce.com, inc."
ComboBox1.AddItem "CTL": ComboBox1.List(49, 1) = "CenturyLink, Inc."
ComboBox1.AddItem "CVX": ComboBox1.List(50, 1) = "Chevron Corporation"
ComboBox1.AddItem "CXB": ComboBox1.List(51, 1) = "Calibre Mining Corp(NDA)"
ComboBox1.AddItem "D": ComboBox1.List(52, 1) = "Dominion Resources, Inc."
ComboBox1.AddItem "DDAIF": ComboBox1.List(53, 1) = "Daimler AG (USA)"
ComboBox1.AddItem "DDS": ComboBox1.List(54, 1) = "Dillard's, Inc."
ComboBox1.AddItem "Deloitte & Touche (M.E.)": ComboBox1.List(55, 1) = "Deloitte & Touche (M.E.)"
ComboBox1.AddItem "Deloitte Touche Tohmatsu": ComboBox1.List(56, 1) = "Deloitte Touche Tohmatsu"
ComboBox1.AddItem "DFS": ComboBox1.List(57, 1) = "Discover Financial Ser..."
ComboBox1.AddItem "DHR": ComboBox1.List(58, 1) = "Danaher Corporation"
ComboBox1.AddItem "DML": ComboBox1.List(59, 1) = "Denison Mines Corp."
ComboBox1.AddItem "DTE": ComboBox1.List(60, 1) = "DTE Energy Company"
ComboBox1.AddItem "DTEGY": ComboBox1.List(61, 1) = "Deutsche Telekom AG (ADR)"
ComboBox1.AddItem "E": ComboBox1.List(62, 1) = "Eni S.p.A. (ADR)"
ComboBox1.AddItem "EDAC": ComboBox1.List(63, 1) = "EDAC Technologies Corp."
ComboBox1.AddItem "ENI": ComboBox1.List(64, 1) = "Eni S.p.A."
ComboBox1.AddItem "EPIC": ComboBox1.List(65, 1) = "Epicor Software Corp."
ComboBox1.AddItem "EPR": ComboBox1.List(66, 1) = "Entertainment Properti..."
ComboBox1.AddItem "EPZ": ComboBox1.List(67, 1) = "Esperanza Resources Corp"
ComboBox1.AddItem "EQY": ComboBox1.List(68, 1) = "Equity One, Inc."
ComboBox1.AddItem "Ernst & Young (Egypt)": ComboBox1.List(69, 1) = "Ernst & Young (Egypt)"
ComboBox1.AddItem "Ernst & Young Qatar": ComboBox1.List(70, 1) = "Ernst & Young Qatar"
ComboBox1.AddItem "ESL": ComboBox1.List(71, 1) = "Esterline Tech. Corp."
ComboBox1.AddItem "F": ComboBox1.List(72, 1) = "Ford Motor Company"
ComboBox1.AddItem "FAF": ComboBox1.List(73, 1) = "First American Financi..."
ComboBox1.AddItem "FAN": ComboBox1.List(74, 1) = "Farallon Mining Ltd."
ComboBox1.AddItem "FAVS": ComboBox1.List(75, 1) = "First Aviation Services"
ComboBox1.AddItem "FIS": ComboBox1.List(76, 1) = "Fidelity National Info..."
ComboBox1.AddItem "FIU": ComboBox1.List(77, 1) = "First Uranium Corporation"
ComboBox1.AddItem "FLO": ComboBox1.List(78, 1) = "Flowers Foods, Inc."
ComboBox1.AddItem "FNF": ComboBox1.List(79, 1) = "Fidelity National Fina..."
ComboBox1.AddItem "FSS": ComboBox1.List(80, 1) = "Federal Signal Corpora..."
ComboBox1.AddItem "G": ComboBox1.List(81, 1) = "Genpact Limited"
ComboBox1.AddItem "G": ComboBox1.List(82, 1) = "Goldcorp Inc."
ComboBox1.AddItem "GAM": ComboBox1.List(83, 1) = "Gammon Gold, Inc."
ComboBox1.AddItem "GDOT": ComboBox1.List(84, 1) = "Green Dot Corporation"
ComboBox1.AddItem "GE": ComboBox1.List(85, 1) = "General Electric Company"
ComboBox1.AddItem "GET": ComboBox1.List(86, 1) = "Gaylord Entertainment Co."
ComboBox1.AddItem "GIS": ComboBox1.List(87, 1) = "General Mills, Inc."
ComboBox1.AddItem "GIT": ComboBox1.List(88, 1) = "Gitennes Exploration Inc."
ComboBox1.AddItem "GNCMA": ComboBox1.List(89, 1) = "General Communication,..."
ComboBox1.AddItem "GOM": ComboBox1.List(90, 1) = "Golden Dawn Minerals Inc."
ComboBox1.AddItem "GOTTQ": ComboBox1.List(91, 1) = "Gottschalks Inc."
ComboBox1.AddItem "GPN": ComboBox1.List(92, 1) = "Global Payments Inc."
ComboBox1.AddItem "GR": ComboBox1.List(93, 1) = "Goodrich Corporation"
ComboBox1.AddItem "GRT": ComboBox1.List(94, 1) = "Glimcher Realty Trust"
ComboBox1.AddItem "GS": ComboBox1.List(95, 1) = "Goldman Sachs Group, Inc."
ComboBox1.AddItem "H": ComboBox1.List(96, 1) = "Hyatt Hotels Corporation"
ComboBox1.AddItem "HAIN": ComboBox1.List(97, 1) = "The Hain Celestial Gro..."
ComboBox1.AddItem "HBC": ComboBox1.List(98, 1) = "HSBC Holdings plc (ADR)"
ComboBox1.AddItem "HEI": ComboBox1.List(99, 1) = "HEICO Corporation"
ComboBox1.AddItem "HMC": ComboBox1.List(100, 1) = "HONDA MOTOR CO., LTD. ..."
ComboBox1.AddItem "HON": ComboBox1.List(101, 1) = "Honeywell Intl. Inc."
ComboBox1.AddItem "HOT": ComboBox1.List(102, 1) = "Starwood Hotels & Reso..."
ComboBox1.AddItem "IDT": ComboBox1.List(103, 1) = "IDT Corporation"
ComboBox1.AddItem "IHG": ComboBox1.List(104, 1) = "InterContinental Hotel..."
ComboBox1.AddItem "ILXRQ": ComboBox1.List(105, 1) = "ILX Resorts Incorporated"
ComboBox1.AddItem "INTU": ComboBox1.List(106, 1) = "Intuit Inc."
ComboBox1.AddItem "IRC": ComboBox1.List(107, 1) = "Inland Real Estate Corp."
ComboBox1.AddItem "ITCD": ComboBox1.List(108, 1) = "ITC DeltaCom, Inc."
ComboBox1.AddItem "ITIC": ComboBox1.List(109, 1) = "Investors Title Company"
ComboBox1.AddItem "JBHT": ComboBox1.List(110, 1) = "J.B. Hunt Transport Se..."
ComboBox1.AddItem "JCP": ComboBox1.List(111, 1) = "J.C. Penney Company, Inc."
ComboBox1.AddItem "JDSU": ComboBox1.List(112, 1) = "JDS Uniphase Corporation"
ComboBox1.AddItem "JJSF": ComboBox1.List(113, 1) = "J&J Snack Foods Corp."
ComboBox1.AddItem "JPM": ComboBox1.List(114, 1) = "JPMorgan Chase & Co."
ComboBox1.AddItem "JWN": ComboBox1.List(115, 1) = "Nordstrom, Inc."
ComboBox1.AddItem "K": ComboBox1.List(116, 1) = "Kellogg Company"
ComboBox1.AddItem "KEI": ComboBox1.List(117, 1) = "Keithley Instruments, ..."
ComboBox1.AddItem "KELLQ": ComboBox1.List(118, 1) = "Kellstrom Industries Inc."
ComboBox1.AddItem "KFT": ComboBox1.List(119, 1) = "Kraft Foods Inc."
ComboBox1.AddItem "KIA": ComboBox1.List(120, 1) = "Kria Resources Ltd"
ComboBox1.AddItem "KIM": ComboBox1.List(121, 1) = "Kimco Realty Corporation"
ComboBox1.AddItem "KPMG Oman": ComboBox1.List(122, 1) = "KPMG Oman"
ComboBox1.AddItem "KRI": ComboBox1.List(123, 1) = "Khan Resources Inc."
ComboBox1.AddItem "KRSL": ComboBox1.List(124, 1) = "Kreisler Manufacturing..."
ComboBox1.AddItem "KSS": ComboBox1.List(125, 1) = "Kohl's Corporation"
ComboBox1.AddItem "L": ComboBox1.List(126, 1) = "Loews Corporation"
ComboBox1.AddItem "LCRY": ComboBox1.List(127, 1) = "LeCROY Corporation"
ComboBox1.AddItem "LEAP": ComboBox1.List(128, 1) = "Leap Wireless Intl., Inc."
ComboBox1.AddItem "LIFE": ComboBox1.List(129, 1) = "Life Technologies Corp."
ComboBox1.AddItem "LVLT": ComboBox1.List(130, 1) = "Level 3 Communications..."
ComboBox1.AddItem "LWSN": ComboBox1.List(131, 1) = "Lawson Software, Inc."
ComboBox1.AddItem "M": ComboBox1.List(132, 1) = "Macy's, Inc."
ComboBox1.AddItem "MA": ComboBox1.List(133, 1) = "MasterCard Incorporated"
ComboBox1.AddItem "MAC": ComboBox1.List(134, 1) = "The Macerich Company"
ComboBox1.AddItem "MAR": ComboBox1.List(135, 1) = "Marriott Intl., Inc."
ComboBox1.AddItem "MFL": ComboBox1.List(136, 1) = "Minefinders Corp. Ltd."
ComboBox1.AddItem "MGR": ComboBox1.List(137, 1) = "Murgor Resources Inc."
ComboBox1.AddItem "MHGC": ComboBox1.List(138, 1) = "Morgans Hotel Group Co."
ComboBox1.AddItem "MKL": ComboBox1.List(139, 1) = "Markel Corporation"
ComboBox1.AddItem "MS": ComboBox1.List(140, 1) = "Morgan Stanley"
ComboBox1.AddItem "MSFT": ComboBox1.List(141, 1) = "Microsoft Corporation"
ComboBox1.AddItem "MSFT": ComboBox1.List(142, 1) = "Microsoft Corporation"
ComboBox1.AddItem "MT": ComboBox1.List(143, 1) = "ArcelorMittal (ADR)"
ComboBox1.AddItem "MTL": ComboBox1.List(144, 1) = "Mechel OAO (ADR)"
ComboBox1.AddItem "N": ComboBox1.List(145, 1) = "NetSuite Inc."
ComboBox1.AddItem "NATI": ComboBox1.List(146, 1) = "National Instruments Corp"
ComboBox1.AddItem "NAV": ComboBox1.List(147, 1) = "Navistar Intl. Corp."
ComboBox1.AddItem "NAVG": ComboBox1.List(148, 1) = "The Navigators Group, Inc"
ComboBox1.AddItem "NI": ComboBox1.List(149, 1) = "NiSource Inc."
ComboBox1.AddItem "NSANY": ComboBox1.List(150, 1) = "Nissan Motor Co., Ltd...."
ComboBox1.AddItem "NTG": ComboBox1.List(151, 1) = "Northgate plc"
ComboBox1.AddItem "NTLS": ComboBox1.List(152, 1) = "NTELOS Holdings Corp."
ComboBox1.AddItem "NTSP": ComboBox1.List(153, 1) = "NetSpend Holdings Inc"
ComboBox1.AddItem "NUE": ComboBox1.List(154, 1) = "Nucor Corporation"
ComboBox1.AddItem "Nutifood Corp": ComboBox1.List(155, 1) = "Nutifood Corp"
ComboBox1.AddItem "O": ComboBox1.List(156, 1) = "Realty Income Corp"
ComboBox1.AddItem "OB": ComboBox1.List(157, 1) = "OneBeacon Insurance Gr..."
ComboBox1.AddItem "ODFL": ComboBox1.List(158, 1) = "Old Dominion Freight Line"
ComboBox1.AddItem "OEFI": ComboBox1.List(159, 1) = "Omani Euro Food Indust..."
ComboBox1.AddItem "OGZPY": ComboBox1.List(160, 1) = "Gazprom OAO (ADR)"
ComboBox1.AddItem "ORCL": ComboBox1.List(161, 1) = "Oracle Corporation"
ComboBox1.AddItem "ORI": ComboBox1.List(162, 1) = "Old Republic Intl. Corp."
ComboBox1.AddItem "P": ComboBox1.List(163, 1) = "Primero Mining Corp"
ComboBox1.AddItem "PACR": ComboBox1.List(164, 1) = "Pacer International, Inc."
ComboBox1.AddItem "PAET": ComboBox1.List(165, 1) = "PAETEC Holding Corp."
ComboBox1.AddItem "PCS": ComboBox1.List(166, 1) = "MetroPCS Communication..."
ComboBox1.AddItem "PKX": ComboBox1.List(167, 1) = "POSCO (ADR)"
ComboBox1.AddItem "PNC": ComboBox1.List(168, 1) = "PNC Financial Services"
ComboBox1.AddItem "PUC": ComboBox1.List(169, 1) = "Pancontinental Uranium..."
ComboBox1.AddItem "Q": ComboBox1.List(170, 1) = "Qwest Communications I..."
ComboBox1.AddItem "QRM": ComboBox1.List(171, 1) = "Quest Rare Minerals Ltd."
ComboBox1.AddItem "QTA": ComboBox1.List(172, 1) = "Quaterra Resources Inc."
ComboBox1.AddItem "R": ComboBox1.List(173, 1) = "Ryder System, Inc."
ComboBox1.AddItem "RAH": ComboBox1.List(174, 1) = "Ralcorp Holdings, Inc."
ComboBox1.AddItem "RBS": ComboBox1.List(175, 1) = "Royal Bank of Scotland..."
ComboBox1.AddItem "RDS.A": ComboBox1.List(176, 1) = "Royal Dutch Shell plc ..."
ComboBox1.AddItem "REP": ComboBox1.List(177, 1) = "Repsol YPF, S.A. (ADR)"
ComboBox1.AddItem "RLH": ComboBox1.List(178, 1) = "Red Lion Hotels Corp."
ComboBox1.AddItem "RLI": ComboBox1.List(179, 1) = "RLI Corp."
ComboBox1.AddItem "S": ComboBox1.List(180, 1) = "Sprint Nextel Corporation"
ComboBox1.AddItem "SAP": ComboBox1.List(181, 1) = "SAP AG (ADR)"
ComboBox1.AddItem "SCG": ComboBox1.List(182, 1) = "SCANA Corporation"
ComboBox1.AddItem "SCHN": ComboBox1.List(183, 1) = "Schnitzer Steel Indust..."
ComboBox1.AddItem "SHLD": ComboBox1.List(184, 1) = "Sears Holdings Corpora..."
ComboBox1.AddItem "SHN": ComboBox1.List(185, 1) = "Pencari Mining Corp."
ComboBox1.AddItem "SIF": ComboBox1.List(186, 1) = "SIFCO Industries, Inc."
ComboBox1.AddItem "SIGI": ComboBox1.List(187, 1) = "Selective Insurance Group"
ComboBox1.AddItem "SKS": ComboBox1.List(188, 1) = "Saks Incorporated"
ComboBox1.AddItem "SKT": ComboBox1.List(189, 1) = "Tanger Factory Outlet ..."
ComboBox1.AddItem "SLR": ComboBox1.List(190, 1) = "Slancho AD Svishtov"
ComboBox1.AddItem "SLW": ComboBox1.List(191, 1) = "Silver Wheaton Corp."
ComboBox1.AddItem "SMZ": ComboBox1.List(192, 1) = "Sinchao Metals Corp."
ComboBox1.AddItem "SNSTA": ComboBox1.List(193, 1) = "Sonesta Intl. Hotels C..."
ComboBox1.AddItem "SOI": ComboBox1.List(194, 1) = "Sirios Resources Inc."
ComboBox1.AddItem "SPAR": ComboBox1.List(195, 1) = "Spartan Motors, Inc."
ComboBox1.AddItem "SPMYY": ComboBox1.List(196, 1) = "Spirent Communications..."
ComboBox1.AddItem "SRE": ComboBox1.List(197, 1) = "Sempra Energy"
ComboBox1.AddItem "STC": ComboBox1.List(198, 1) = "Stewart Information Se..."
ComboBox1.AddItem "STLD": ComboBox1.List(199, 1) = "Steel Dynamics, Inc."
ComboBox1.AddItem "STO": ComboBox1.List(200, 1) = "Statoil ASA(ADR)"
ComboBox1.AddItem "SVLF": ComboBox1.List(201, 1) = "Silverleaf Resorts, Inc."
ComboBox1.AddItem "T": ComboBox1.List(202, 1) = "AT&T Inc."
ComboBox1.AddItem "TDS": ComboBox1.List(203, 1) = "Telephone & Data Syste..."
ComboBox1.AddItem "TEG": ComboBox1.List(204, 1) = "Integrys Energy Group,..."
ComboBox1.AddItem "TGI": ComboBox1.List(205, 1) = "Triumph Group, Inc."
ComboBox1.AddItem "TGT": ComboBox1.List(206, 1) = "Target Corporation"
ComboBox1.AddItem "THG": ComboBox1.List(207, 1) = "The Hanover Insurance ..."
ComboBox1.AddItem "TM": ComboBox1.List(208, 1) = "Toyota Motor Corp. (ADR)"
ComboBox1.AddItem "TMO": ComboBox1.List(209, 1) = "Thermo Fisher Scientif..."
ComboBox1.AddItem "TNO": ComboBox1.List(210, 1) = "RSM Tenon Group PLC"
ComboBox1.AddItem "TOT": ComboBox1.List(211, 1) = "TOTAL S.A. (ADR)"
ComboBox1.AddItem "TRV": ComboBox1.List(212, 1) = "The Travelers Companie..."
ComboBox1.AddItem "TSLA": ComboBox1.List(213, 1) = "Tesla Motors Inc"
ComboBox1.AddItem "TTM": ComboBox1.List(214, 1) = "Tata Motors Limited (ADR)"
ComboBox1.AddItem "TX": ComboBox1.List(215, 1) = "Ternium S.A. (ADR)"
ComboBox1.AddItem "U": ComboBox1.List(216, 1) = "Uranium Participation ..."
ComboBox1.AddItem "UHAL": ComboBox1.List(217, 1) = "AMERCO"
ComboBox1.AddItem "UniGroup, Inc.": ComboBox1.List(218, 1) = "UniGroup, Inc."
ComboBox1.AddItem "UUU": ComboBox1.List(219, 1) = "Uranium One Inc."
ComboBox1.AddItem "V": ComboBox1.List(220, 1) = "Visa Inc."
ComboBox1.AddItem "VLKAY": ComboBox1.List(221, 1) = "Volkswagen AG (ADR)"
ComboBox1.AddItem "VZ": ComboBox1.List(222, 1) = "Verizon Communications..."
ComboBox1.AddItem "WFC": ComboBox1.List(223, 1) = "Wells Fargo & Company"
ComboBox1.AddItem "WMT": ComboBox1.List(224, 1) = "Wal-Mart Stores, Inc."
ComboBox1.AddItem "WOR": ComboBox1.List(225, 1) = "Worthington Industries..."
ComboBox1.AddItem "WRB": ComboBox1.List(226, 1) = "W.R. Berkley Corporation"
ComboBox1.AddItem "WRI": ComboBox1.List(227, 1) = "Weingarten Realty Inve..."
ComboBox1.AddItem "WTT": ComboBox1.List(228, 1) = "Wireless Telecom Group..."
ComboBox1.AddItem "X": ComboBox1.List(229, 1) = "United States Steel Corp."
ComboBox1.AddItem "XOHO": ComboBox1.List(230, 1) = "XO Holdings Inc."
ComboBox1.AddItem "XOM": ComboBox1.List(231, 1) = "Exxon Mobil Corporation"
ComboBox1.AddItem "XPO": ComboBox1.List(232, 1) = "Express-1 Expedited So..."
ComboBox1.AddItem "Y": ComboBox1.List(233, 1) = "Alleghany Corporation"
ComboBox1.AddItem "Z": ComboBox1.List(234, 1) = "Stronghold Metals Inc."

End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public 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
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'It may take a few seconds, please wait.
Public Const URL1 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg" 'Microsoft Office Excel® Kod Klavuzu [Vector Backround]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
Public Const URL3 As String = "http://4.bp.blogspot.com/_hsHTxo_5L8E/TKHXL1-dHVI/AAAAAAAAClo/xxJAhuSHReI/s1600/seven-shine-1024-768.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
Public URL As String
Sub FormAç() 'Open UserForm

On Error Resume Next
UserForm1.Show 0

End Sub
Public 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

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