Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

11 Aralık 2010 Cumartesi

Use The Windows Media Player Library By The Excel Workbook



'Workbook CodePage

'Normal Reference Add
'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: WMPLib, Description: Windows Media Player, FullPath: C:\WINDOWS\system32\wmp.dll

Option Explicit
Private WMP1 As New WMPLib.WindowsMediaPlayer
Private StatusL(1 To 4)
Private Durum As Boolean
Private Sub Workbook_Open()

Durum = True
Call Play_WMP

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Durum = False

End Sub
Private Sub Play_WMP()'By Kitaro & By Celine Dion & Luis Armstrong And Danny Kaye

With WMP1

.currentPlaylist.Clear
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609818.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615108.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608318.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610533.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614499.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610625.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608703.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613713.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608264.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608155.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608166.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608183.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608199.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608204.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608227.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608282.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608304.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608335.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608356.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608382.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608396.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608408.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608423.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608450.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608531.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608538.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608552.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608563.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608573.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608594.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608609.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608781.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608618.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608630.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608658.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608673.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608675.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608697.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608787.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608800.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608813.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608823.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608830.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608842.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/608860.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609712.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609681.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609705.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609725.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609732.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609753.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609773.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609794.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609838.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/609876.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610285.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610298.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610303.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610521.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610527.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610530.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610531.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610542.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610551.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610554.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610565.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610573.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610583.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610594.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610601.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610612.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610616.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610623.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610635.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610726.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610737.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610766.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610770.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610782.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610787.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610801.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/610816.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612913.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612580.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612614.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612628.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612647.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612690.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612706.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612721.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612737.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612752.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612765.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612774.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612777.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612814.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612839.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612845.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612853.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612857.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612867.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612877.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612937.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612959.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612978.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/612999.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613011.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613034.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613048.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613118.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613099.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613133.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613143.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613156.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613174.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613189.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613193.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613205.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613212.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613219.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613231.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613240.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613245.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613250.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613270.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613277.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613306.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613346.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613393.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613451.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613921.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613748.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613763.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613773.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613778.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613796.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613844.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613856.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613885.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613891.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613902.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613958.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613974.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/613993.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614005.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614021.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614026.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614037.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614044.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614057.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614067.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614075.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614089.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614096.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614107.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614252.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614257.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614468.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614472.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614476.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614480.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614487.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614491.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614494.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614504.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614509.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614512.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614522.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614524.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614527.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614532.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614547.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614539.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614544.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614559.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614564.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614573.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614582.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614641.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614653.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614669.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614675.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614685.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/614698.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615063.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615094.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615502.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615561.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615622.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615660.mp3")
.currentPlaylist.appendItem .newMedia("http://www.musicwebtown.com/rhwfu/playlists/77433/615689.mp3")
.currentPlaylist.appendItem .newMedia("http://dc122.4shared.com/img/mClaJlN3/LOUIS_ARMSTRONG__DANNY_KAYE.WMV")
.currentPlaylist.appendItem .newMedia("http://www.musiconline.com.br/somzera/videos/arq/videoclipes/CelineDion-MyHeartWillGoOn.wmv")
.Controls.Play

End With
Call Status

End Sub
Private Sub Status()

Do While Durum = True

With WMP1.currentMedia

If .Name <> StatusL(3) Then

StatusL(1) = .attributeCount
StatusL(2) = .durationString
StatusL(3) = .Name
StatusL(4) = .SourceUrl
Application.StatusBar = "[" & StatusL(1) & "][" & StatusL(2) & "][" & StatusL(3) & "][" & StatusL(4) & "]"

End If

End With
DoEvents

Loop

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

9 Aralık 2010 Perşembe

Enumerate Windows Styles [1]



'UserForm1

'A) Normal Reference Add

'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: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX
'B) Tools Add on UserForm1\
'B1. Image1
'B2. Label1
'B3. Label2
'B4. ImageList (Automatic setup in Module1 with private dimention)
Option Explicit
Public Sub UserForm_Initialize()

Me.Caption = "[PBİD®] Enumerate Windows Styles"
Call Ekran_Düzenle
Call Resim_Ekle(Me)
Call UserForm_Tip1(Me)
DoEvents
End Sub
Private Sub UserForm_Activate()

Me.Move (Application.Width - Me.Width) / 2, (Application.Height - Me.Height) / 2
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Application.Visible = True
End Sub
Private Sub Ekran_Düzenle()

On Error Resume Next
With Me
.Height = 336
.Width = 336
.BackColor = VBA.vbWhite
.Picture = Resim(URL1)
'.Picture = LoadPicture("C:\...\*.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
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
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
Private Enum WindowStyles 'Enumerate windows styles

WS_OVERLAPPED = &H0
WS_POPUP = &H80000000
WS_CHILD = &H40000000
WS_MINIMIZE = &H20000000
WS_VISIBLE = &H10000000
WS_DISABLED = &H8000000
WS_CLIPSIBLINGS = &H4000000
WS_CLIPCHILDREN = &H2000000
WS_MAXIMIZE = &H1000000
WS_BORDER = &H800000
WS_DLGFRAME = &H400000
WS_VSCROLL = &H200000
WS_HSCROLL = &H100000
WS_SYSMENU = &H80000
WS_THICKFRAME = &H40000
WS_GROUP = &H20000
WS_TABSTOP = &H10000
WS_MINIMIZEBOX = &H20000
WS_MAXIMIZEBOX = &H10000
WS_CAPTION = WS_BORDER Or WS_DLGFRAME
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
WS_CHILDWINDOW = WS_CHILD
End Enum
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal WindowStyles As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private hForm 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal Index As Long) As Long
Private IList As New ImageList
Private hImage As Long
Private UWind As Long
Sub Form_Aç() 'Open UserForm

Application.Visible = False
Load UserForm1
End Sub
Public Function UserForm_Tip1(UForm As UserForm) 'Enumerated windows styles [X][X][X]

If Val(Application.Version) = 8 Then
hForm = FindWindow("ThunderXFrame", UForm.Caption)
Else
hForm = FindWindow("ThunderDFrame", UForm.Caption)
End If
SetWindowLong hForm, -16, WS_CAPTION + WS_SYSMENU + WS_MINIMIZEBOX + WS_MAXIMIZEBOX
ShowWindow hForm, 5
End Function
Public Function Resim_Ekle(UForm As UserForm) 'Add icon on sysmenu
IList.ListImages.Add 1, "R1", LoadPicture("C:\Program Files\Microsoft Office\OFFICE11\MSN.ico")

hImage = IList.ListImages(1).Picture
If Val(Application.Version) = 8 Then

UWind = FindWindow("ThunderXFrame", UForm.Caption)
Else
UWind = FindWindow("ThunderDFrame", UForm.Caption)
End If
If UWind = 0 Then Exit Function
SendMessage UWind, &H80, True, hImage: SendMessage UWind, &H80, False, hImage
SetWindowLong UWind, (-20), GetWindowLong(UWind, (-20)) And Not &H1
DrawMenuBar UWind
End Function
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

1 Aralık 2010 Çarşamba

Create xlBitmap Picture From xlScreen Source



'Module1

'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


Option Explicit
Private Type GUID

Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte

End Type
Private DispatchGuid As GUID
Private Type uPicDesc

Size As Long
Type As Long
hPic As Long
hPal As Long

End Type
Private PictureDescription As uPicDesc
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private IPic As IPicture
Private hPtr As Long
Sub Create_xlScreenxlBitmap_Picture()

On Error Resume Next
Cells(1, 1).Interior.Color = RGB(0, 0, 0)
Cells(1, 2).Interior.Color = RGB(153, 51, 0)
Cells(1, 3).Interior.Color = RGB(51, 51, 0)
Cells(1, 4).Interior.Color = RGB(0, 51, 0)
Cells(1, 5).Interior.Color = RGB(0, 51, 102)
Cells(1, 6).Interior.Color = RGB(0, 0, 128)
Cells(1, 7).Interior.Color = RGB(51, 51, 153)
Cells(1, 8).Interior.Color = RGB(51, 51, 51)
Cells(2, 1).Interior.Color = RGB(128, 0, 0)
Cells(2, 2).Interior.Color = RGB(255, 102, 0)
Cells(2, 3).Interior.Color = RGB(128, 128, 0)
Cells(2, 4).Interior.Color = RGB(0, 128, 0)
Cells(2, 5).Interior.Color = RGB(0, 128, 128)
Cells(2, 6).Interior.Color = RGB(0, 0, 255)
Cells(2, 7).Interior.Color = RGB(102, 102, 153)
Cells(2, 8).Interior.Color = RGB(128, 128, 128)
Cells(3, 1).Interior.Color = RGB(255, 0, 0)
Cells(3, 2).Interior.Color = RGB(255, 153, 0)
Cells(3, 3).Interior.Color = RGB(153, 204, 0)
Cells(3, 4).Interior.Color = RGB(51, 153, 102)
Cells(3, 5).Interior.Color = RGB(51, 204, 204)
Cells(3, 6).Interior.Color = RGB(51, 102, 255)
Cells(3, 7).Interior.Color = RGB(128, 0, 128)
Cells(3, 8).Interior.Color = RGB(150, 150, 150)
Cells(4, 1).Interior.Color = RGB(255, 0, 255)
Cells(4, 2).Interior.Color = RGB(255, 204, 0)
Cells(4, 3).Interior.Color = RGB(255, 255, 0)
Cells(4, 4).Interior.Color = RGB(0, 255, 0)
Cells(4, 5).Interior.Color = RGB(0, 255, 255)
Cells(4, 6).Interior.Color = RGB(0, 204, 255)
Cells(4, 7).Interior.Color = RGB(153, 51, 102)
Cells(4, 8).Interior.Color = RGB(192, 192, 192)
Cells(5, 1).Interior.Color = RGB(255, 153, 204)
Cells(5, 2).Interior.Color = RGB(255, 204, 153)
Cells(5, 3).Interior.Color = RGB(255, 255, 153)
Cells(5, 4).Interior.Color = RGB(204, 255, 204)
Cells(5, 5).Interior.Color = RGB(204, 255, 255)
Cells(5, 6).Interior.Color = RGB(153, 204, 255)
Cells(5, 7).Interior.Color = RGB(204, 153, 255)
Cells(5, 8).Interior.Color = RGB(255, 255, 255)
RangeSaveAsPicture Range("A1:H5"), "c:\xlScreenxlBitmapPicture.bmp"

End Sub
Private Sub RangeSaveAsPicture(SourceRange As Range, FilePathName As String)

SourceRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
OpenClipboard 0
hPtr = GetClipboardData(2)
CloseClipboard
With DispatchGuid

.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB

End With
With PictureDescription

.Size = Len(PictureDescription)
.Type = 1
.hPic = hPtr
.hPal = 0

End With
OleCreatePictureIndirect PictureDescription, DispatchGuid, True, IPic
stdole.SavePicture IPic, FilePathName

End Sub

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

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

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
Anadolu Üniversitesi Açık Öğretim Fakültesi