Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

31 Mart 2010 Çarşamba

UserForm Skins in VBA




'UserForm1

'A) Windows XP® Office 2003® Normal Referance 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 
    'Name: MSComctlLib , Description: Microsoft Windows Common Controls 6.0 (SP6) 
    'Name: ACTIVESKINLib , Description: ActiveSkin 4.0 Type Library
'B) Additional Controls
    'Alt + F11; Microsoft Visual Basic VBE Editor
    'Tools\Additional Controls\ActiveSkin Control= OK
    'Skin1 Object to move on UserForm1 from ToolBox
'C) UserForm1'e Eklenen Araçlar (Add Tools)
    'ComboBox1
    'Skin1
'D) Macro Security Options
    'Araçlar [Tools] \ Makro [Macro] \ Güvenlik [Security] \ Güvenlik Düzeyi [Security Level]= Düşük [Low]
    'Araçlar [Tools] \ Makro [Macro] \ Güvenlik [Security] \ Güvenilen Yayımcılar [Trusted Publishers] \ Tüm yüklü eklentilere ve şablonlara güven [Trust all installed add-ins and templates]= OK
    'Araçlar [Tools] \ Makro [Macro] \ Güvenlik [Security] \ Güvenilen Yayımcılar [Trusted Publishers] \ Visual Basic Projesine erişime güven [Trust access to Visual Basic project]= OK
'E) Download Free *.skn Files Web Source
    'http://www.recursosvisualbasic.com.ar/htm/ocx-componentes-activex-dll/zip/207-skins-morpheus.zip

Option Explicit
Private No As Double
Private FSO As Object, Klasör As Object, Dosya As Object
Private SeçilenDosya As String
Private Const Hwnd As Long = &H0
Private Sub UserForm_Initialize()
    On Error Resume Next
    Application.Visible = False
    With Me
        .Caption = "[PBİD®]UserForm Skin"
        .Height = 226
        .Width = 358
    End With
    With ComboBox1
        .Left = 6
        .Top = 6
        .Height = 18
        .Width = 114
    End With
    Call SkinDosyaListele
End Sub
Private Sub UserForm_Terminate()

    On Error Resume Next
    Skin1.Empty
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    On Error Resume Next
    Application.Visible = True
End Sub
Private Sub ComboBox1_Change()

    On Error Resume Next
    SeçilenDosya = ComboBox1.List(ComboBox1.ListIndex, 1)
    With Skin1
        .LoadSkin SeçilenDosya
        .ApplySkin Hwnd
        .ZOrder 1
    End With
    DoEvents
End Sub
Sub SkinDosyaListele()

    On Error Resume Next
    No = 0
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set Klasör = FSO.GetFolder("C:\Documents and Settings\PC\Belgelerim\Mustafa ULUSARAÇ\Skins\")
    For Each Dosya In Klasör.Files
        ComboBox1.AddItem Dosya.Name
        ComboBox1.List(No, 1) = Dosya
        No = No + 1
    Next Dosya
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