Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Mart 2010 Cumartesi

Associates a ProgID with a CLSID (GUID Number)



'UserForm1


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

'Visual Basic For Aplication
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'Microsoft Forms 2.0 Object Library

'B) UserForm1'e Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'Image2
Option Explicit
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Private Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Private IPic(15) As Byte
Private Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
'It may take a few seconds, please wait.

Private Const URL1 As String = "http://1.bp.blogspot.com/_hsHTxo_5L8E/S7qBVjh2ifI/AAAAAAAACRc/gcQP-MPAaW8/s1600/Bant.JPG" 'Microsoft Office Excel® Kod Kılavuzu
Private Const URL2 As String = "http://nachbelichtet.com/wp-content/uploads/2008/01/TAPFS.jpg"
'Pink Floyd Concert


Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Associates a ProgID with a CLSID (GUID Number)"
Call EkranDüzenle
End Sub
Private Function Resim(URL) As Picture

On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
Private Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 360
.Width = 456
.BackColor = vbWhite
With Frame1
.Caption = ""
.Top = 0
.Left = 0
.Height = 36
.Width = Me.InsideWidth
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
.PictureTiling = False
.SpecialEffect = fmSpecialEffectFlat
.BackColor = vbWhite
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.Picture = LoadPicture("C:\Documents and Settings\ULUSARAÇ\Belgelerim\Mustafa ULUSARAÇ\PBİD.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 With
With Image2
.Left = 0
.Top = 30
.Height = Me.InsideHeight - 30
.Width = Me.InsideWidth
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
.PictureTiling = False
.Picture = Resim(URL2)
.SpecialEffect = fmSpecialEffectFlat
End With
End With
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul