Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Kasım 2011 Pazar

GetSystemMenu Options For Excel, WorkBook And UserForm


'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) Image1, Label1, Label2
'2) Label3, Label4, Label5, Label6, Label7, Label8
'3) ToggleButton1, ToggleButton2, ToggleButton3
'4) ToggleButton4, ToggleButton5, ToggleButton6
'5) ToggleButton7, ToggleButton8, ToggleButton9
Private i As Single
Private Const GWL_STYLE = -16&
Private Const SC_CLOSE = &HF060
Private Const MF_BYCOMMAND = &H0
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal myHwnd As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal myHwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private hMenu As Long
Private hWndStyle As Long
Private UFhWnd As Long
Private XLhWnd As Long
Private WBhWnd As Long
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] GetSystemMenu Options For Excel, WorkBook And UserForm"
Call Ekran_Duzenle
Call Find_hWnd
Call Open_Buttons
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
Call Open_Buttons
End Sub
Private Sub ToggleButton1_Click()
On Error Resume Next
With Me.ToggleButton1
If .Value Then
Call AddMinButton(UFhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMinButton(UFhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub ToggleButton2_Click()
On Error Resume Next
With Me.ToggleButton2
If .Value Then
Call AddMaxButton(UFhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMaxButton(UFhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub ToggleButton3_Click()
On Error Resume Next
With Me.ToggleButton3
If .Value Then
Call AddCloseButton(UFhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelCloseButton(UFhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub ToggleButton4_Click()
On Error Resume Next
With Me.ToggleButton4
If .Value Then
Call AddMinButton(WBhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMinButton(WBhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
With Application.Windows(ThisWorkbook.Name)
.WindowState = xlMaximized
.WindowState = xlNormal
End With
End Sub
Private Sub ToggleButton5_Click()
On Error Resume Next
With Me.ToggleButton5
If .Value Then
Call AddMaxButton(WBhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMaxButton(WBhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
With Application.Windows(ThisWorkbook.Name)
.WindowState = xlMaximized
.WindowState = xlNormal
End With
End Sub
Private Sub ToggleButton6_Click()
On Error Resume Next
With Me.ToggleButton6
If .Value Then
Call AddCloseButton(WBhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelCloseButton(WBhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
With Application.Windows(ThisWorkbook.Name)
.WindowState = xlMaximized
.WindowState = xlNormal
End With
End Sub
Private Sub ToggleButton7_Click()
On Error Resume Next
With Me.ToggleButton7
If .Value Then
Call AddMinButton(XLhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMinButton(XLhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub ToggleButton8_Click()
On Error Resume Next
With Me.ToggleButton8
If .Value Then
Call AddMaxButton(XLhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelMaxButton(XLhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub ToggleButton9_Click()
On Error Resume Next
With Me.ToggleButton9
If .Value Then
Call AddCloseButton(XLhWnd)
.Caption = "ON"
.ForeColor = VBA.ColorConstants.vbBlue
Else
Call DelCloseButton(XLhWnd)
.Caption = "OFF"
.ForeColor = VBA.ColorConstants.vbRed
End If
End With
End Sub
Private Sub Find_hWnd()
On Error Resume Next
UFhWnd = FindWindow(vbNullString, UserForm1.Caption)
XLhWnd = FindWindow("XLMAIN", Application.Caption)
WBhWnd = FindWindowEx(XLhWnd, 0&, "XLDESK", vbNullString)
WBhWnd = FindWindowEx(WBhWnd, 0&, "EXCEL7", vbNullString)
End Sub
Private Sub AddMinButton(ByVal hWndTipi As Long)
On Error Resume Next
hWndStyle = GetWindowLong(hWndTipi, GWL_STYLE)
hWndStyle = hWndStyle Or WS_MINIMIZEBOX
SetWindowLong hWndTipi, GWL_STYLE, hWndStyle
DrawMenuBar hWndTipi
End Sub
Private Sub DelMinButton(ByVal hWndTipi As Long)
On Error Resume Next
hWndStyle = GetWindowLong(hWndTipi, GWL_STYLE)
hWndStyle = hWndStyle And Not WS_MINIMIZEBOX
SetWindowLong hWndTipi, GWL_STYLE, hWndStyle
DrawMenuBar hWndTipi
End Sub
Private Sub AddMaxButton(ByVal hWndTipi As Long)
On Error Resume Next
hWndStyle = GetWindowLong(hWndTipi, GWL_STYLE)
hWndStyle = hWndStyle Or WS_MAXIMIZEBOX
SetWindowLong hWndTipi, GWL_STYLE, hWndStyle
DrawMenuBar hWndTipi
End Sub
Private Sub DelMaxButton(ByVal hWndTipi As Long)
On Error Resume Next
hWndStyle = GetWindowLong(hWndTipi, GWL_STYLE)
hWndStyle = hWndStyle And Not WS_MAXIMIZEBOX
SetWindowLong hWndTipi, GWL_STYLE, hWndStyle
DrawMenuBar hWndTipi
End Sub
Private Sub AddCloseButton(ByVal hWndTipi As Long)
On Error Resume Next
hMenu = GetSystemMenu(hWndTipi, 1&)
DrawMenuBar hWndTipi
End Sub
Private Sub DelCloseButton(ByVal hWndTipi As Long)
On Error Resume Next
hMenu = GetSystemMenu(hWndTipi, 0&)
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND
DrawMenuBar hWndTipi
End Sub
Private Sub Open_Buttons()
On Error Resume Next
For i = 1 To 9
Me("ToggleButton" & i).Value = True
Next i
Application.WindowState = xlMaximized
Windows(ThisWorkbook.Name).WindowState = xlMaximized
End Sub
Private Sub Ekran_Duzenle()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 160
.Width = 258
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 318
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 318
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 60
.Height = 24
.Width = 60
.Caption = " UserForm"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignLeft
End With
With Label4
.Left = 6
.Top = 84
.Height = 24
.Width = 60
.Caption = " WorkBook"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignLeft
End With
With Label5
.Left = 6
.Top = 108
.Height = 24
.Width = 60
.Caption = " Excel"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = 66
.Top = 36
.Height = 24
.Width = 60
.Caption = "Minumum"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With ToggleButton1
.Left = 66
.Top = 60
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton4
.Left = 66
.Top = 84
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton7
.Left = 66
.Top = 108
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With Label7
.Left = 126
.Top = 36
.Height = 24
.Width = 60
.Caption = "Maximum"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With ToggleButton2
.Left = 126
.Top = 60
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton5
.Left = 126
.Top = 84
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton8
.Left = 126
.Top = 108
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With Label8
.Left = 186
.Top = 36
.Height = 24
.Width = 60
.Caption = "Close"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H404000
.TextAlign = fmTextAlignCenter
End With
With ToggleButton3
.Left = 186
.Top = 60
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton6
.Left = 186
.Top = 84
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
End With
With ToggleButton9
.Left = 186
.Top = 108
.Height = 24
.Width = 60
.Caption = ""
.Alignment = fmAlignmentLeft
.BackStyle = fmBackStyleTransparent
.Enabled = True
.SpecialEffect = fmButtonEffectFlat
.TextAlign = fmTextAlignCenter
.WordWrap = False
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}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç() '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

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