Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Mart 2004 Pazartesi

Prepare a chart on the UserForm object OWC11.ChartSpace.11



'UserForm1
'A) Windows XP® Office 2003® Normal Reference List

'Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL'Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE'Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL'Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'Description: Microsoft Office Web Components 11.0, FullPath: C:\Program Files\Common Files\Microsoft Shared\Web Components\11\OWC11.DLL'Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX
'B) UserForm1'a Eklenen Araçlar (Add Tools)
'Image1, Label1, Label2
'C) Chart Backround Picture
Option Explicit
Dim i As Integer
Dim Grafik As Object
Dim GrafikCategories(1 To 36)
Dim GrafikValues(1 To 36)
Dim ÇerçeveDüzenleme As New Class1
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD ®] Prepare a chart on the UserForm object OWC11.ChartSpace.11"
Call EkranDüzenle
Call GrafikHazırla
Application.Visible = False
Application.VBE.MainWindow.Visible = False
Set ÇerçeveDüzenleme.LogoYerleştir = Me
Set ÇerçeveDüzenleme.Form1 = Me
End Sub
Private Sub UserForm_Activate()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
End Sub
Private Sub UserForm_Resize()

On Error Resume Next
With Me
.Top = (Application.Height - .Height) / 2
.Left = (Application.Width - .Width) / 2
End With
Call GrafikDüzenle
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

On Error Resume Next
Call Kapat
End
End Sub
Sub Kapat()

Set ÇerçeveDüzenleme.FormYokol = Me
Unload Me
Application.Visible = True
Application.VBE.MainWindow.Visible = True
ActiveWorkbook.Save
'Application.Quit
End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me
.Height = 426
.Width = 558
.BackColor = vbWhite
.Picture = LoadPicture("C:\Documents and Settings\ULUSARAÇ\Belgelerim\Mustafa ULUSARAÇ\ExcelÖrnekler\VectorBackround.jpg")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
.SpecialEffect = fmSpecialEffectFlat
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Ç\ExcelÖrnekler\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
Set Grafik = Me.Controls.Add("OWC11.ChartSpace.11")
Call GrafikDüzenle
End With
End Sub
Sub GrafikDüzenle()

On Error Resume Next
With Grafik
.Left = 0
.Top = 36
.Height = Me.InsideHeight - 36
.Width = Me.InsideWidth
End With
DoEvents
End Sub
Sub GrafikHazırla()

On Error Resume Next
For i = 1 To 36
GrafikCategories(i) = VBA.DateSerial(2000, i, 1)
GrafikValues(i) = VBA.Rnd
Next i
'Set Grafik = Me.Controls.Add("OWC11.ChartSpace.11")
With Grafik
.Charts.Add 0
With .Charts(0)
.Type = chChartTypeColumnClustered
With .Axes(0)
.Font.Color = &H4000&
.Font.Size = 8
End With
.HasAutoAspectRatio = True
.HasAutoChartDepth = True
.HasLegend = True
.HasTitle = True
.Interior.SetTwoColorGradient chGradientDiagonalDown, chGradientVariantCenter, vbGreen, vbWhite
.Legend.Position = chLegendPositionBottom
With .PlotArea
With .Border
.Color = vbWhite
.Weight = xlThin
.DashStyle = chLineSolid
End With
.Interior.SetTextured "C:\Documents and Settings\ULUSARAÇ\Belgelerim\Mustafa ULUSARAÇ\ExcelÖrnekler\VistaWallPaper01.jpg", chStretch, 1, chAllFaces
End With
.SeriesCollection.Add 0
With .SeriesCollection(0)
With .Border
.Color = vbWhite
.Weight = xlThin
End With
.Caption = "AxS"
.Interior.SetTextured msoTextureWaterDroplets
.SetData chDimCategories, chDataLiteral, GrafikCategories
.SetData chDimValues, chDataLiteral, GrafikValues
.Type = chChartTypeColumnClustered
End With
With .Title
.Position = chTitlePositionTop
.Caption = "FİZİKSEL İLERLEME"
.Font.Size = 12
.Font.Color = &H4000&
.Font.Bold = True
End With
End With
.Left = 0
.Top = 36
.Height = Me.InsideHeight - 36
.Width = Me.InsideWidth
End With
End Sub

'Module1

Sub FormAç()
'Open UserForm

On Error Resume Next
Load UserForm1
End Sub

'Class1

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal Class_Adı As String, ByVal Ekran_Adı As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Pencere As Long, ByVal Koordinat As Long) As Long
Private Declare Function GetWindowLongA Lib "user32" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal Pencere_Düzeni As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal Pencere As Long, ByVal Koordinat As Long, ByVal Yeni_Boyut As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal Pencere As Long, ByVal Eylem As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal Pencere As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal Pencere As Long, ByVal Anahtar As Long, ByVal Yoğunluk As Byte, ByVal İkinci_İşaret As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal Pencere As Long, ByVal Eski_Durum As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal FormMenü As Long, ByVal Pozisyon As Long, ByVal İlk_İşaret As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Pencere_Düzeni As Long, ByVal Mesaj As Long, ByVal Değişken1 As Long, Değişken2 As Any) As Long
Dim Çerçeve As Long, Tarz As Long, Logo As Long
Dim i As Integer, Derece As Double
Public Property Set LogoYerleştir(Form As Object)

On Error Resume Next
Logo = Form.Image1.Picture.Handle
Çerçeve = FindWindow(vbNullString, Form.Caption)
Call SendMessage(Çerçeve, &H80, 0&, ByVal Logo)
Call SendMessage(Çerçeve, &H80, 1&, ByVal Logo)
End Property
Public Property Set Form1(Form As Object)

On Error Resume Next
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5
'3= Geniş Açar
DrawMenuBar Çerçeve
End Property
Public Property Set FormGörün(Form As Object)

On Error Resume Next
For i = 1 To 255
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, i, &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5
'3=Geniş AçarDrawMenuBar Çerçeve
DoEvents
Next i
End Property
Public Property Set FormYokol(Form As Object)

On Error Resume Next
For i = 1 To 255
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, (255 - i), &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5
DrawMenuBar Çerçeve
DoEvents
Next i
End Property
Public Property Set FormManuelYokol(Form As Object)

On Error Resume Next
Derece = Form.Slider1.Value
SetWindowLong Çerçeve, (-20), GetWindowLong(Çerçeve, (-20)) Or &H80000
SetLayeredWindowAttributes Çerçeve, 0, (255 - Derece), &H2
Çerçeve = FindWindow(vbNullString, Form.Caption)
Tarz = GetWindowLong(Çerçeve, (-16)) Or &H80000 Or &H20000 Or &H10000
SetWindowLong Çerçeve, (-16), Tarz
ShowWindow Çerçeve, 5
DrawMenuBar Çerçeve
DoEvents
End Property
Public Property Set KapatEtkili(Form As Object)

On Error Resume Next
DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 1), &HF060, 0&
DrawMenuBar Çerçeve
End Property
Public Property Set KapatEtkisiz(Form As Object)

On Error Resume Next
DeleteMenu GetSystemMenu(FindWindow("ThunderDFrame", Form.Caption), 0), &HF060, 0&
DrawMenuBar Çerçeve
End Property

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