香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 25th Nov 2005, 19:25 PM | Office Application, API / Add-in | (2836 Reads)

將 Excel,Word 及 OutLook 並排

今天看到一段代碼 (written by ken Puls),介紹給各位

.

Option Explicit

Private Declare Function GetSystemMetrics Lib "user32.dll" _
(ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Const PixToPoint = 0.75

Sub ResizeScreens()
'Macro created 11/24/2005 22:41 by Ken Puls
'Macro Purpose: To make Word use left half of screen, Excel use
' upper right quarter, and outlook lower right quarter of screen
'NOTE: Word, Excel, Powerpoint all use Points (~.75 pixels) to set
' screen sizes. Outlook uses pixels, not points


Dim x As Long, y As Long, lTskBr As Long
Dim xlApp As Object, wdApp As Object, olApp As Object
Dim sMissing As String

'Set height of start menu bar in pixels
lTskBr = 20

'Bind to each of the required applications
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
     sMissing = "Word or "
     Err.Clear
End If
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
     sMissing = sMissing & "Excel or "
     Err.Clear
End If
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
     sMissing = sMissing & "Outlook or "
     Err.Clear
End If
If Len(sMissing) > 0 Then
     MsgBox "Sorry, but I could not find valid instance(s) of " & vbNewLine & _
     Left(sMissing, Len(sMissing) - 4), vbOKOnly + vbCritical, "Missing App!"
Exit Sub
End If
On Error GoTo 0

'Get Screen Metrics in Pixels
x = GetSystemMetrics(SM_CXSCREEN)
y = GetSystemMetrics(SM_CYSCREEN)

'Set screen size & position for Word Application
'Set to left half of screen
'Word measurements must be in points
With wdApp
     .WindowState = 0
     .Top = 0
     .Left = 0
     .Width = 0.5 * x * PixToPoint
     .Height = (y * PixToPoint) - lTskBr
End With

'Set screen size & position for Excel Application
'Set to top right quarter of screen
'Excel measurements must be in points
With xlApp
     .WindowState = 1
     .Top = 0
     .Left = (0.5 * x * PixToPoint) + 1
     .Width = 0.5 * x * PixToPoint
     .Height = (0.5 * y * PixToPoint) - (lTskBr / 2 * PixToPoint)
End With

'Set screen size & position for Outlook Application
'Set to bottom right quarter of screen
'Outlook measurements must be in pixels

With olApp.ActiveExplorer
     .WindowState = 2
     .Top = (0.5 * y) - (lTskBr / 2 / PixToPoint)
     .Left = (0.5 * x)
     .Width = 0.5 * x
     .Height = (0.5 * y) - (lTskBr / 2 / PixToPoint + 1)
End With

End Sub



Orginal article:

http://vbaexpress.com/forum/showthread.php?t=6126&page=1&pp=20

-Added support for Access & Visio
-Creates an instance of the application if one is not already present
Ver 1.02 Download

Last update: 5 Feb 2006


[3]

暫時沒想到用途.....﹍﹍-_-


[引用] | 作者 TTKSLUB | 17th Mar 2007 00:34 AM | [舉報垃圾留言]

[2]

將 Word, Excel 及 Outlook 三個視窗排列。 Word 佔左方一半,Excel 及 Outlook 佔右方一半。


[引用] | 作者 Emily | 25th Nov 2005 22:10 PM | [舉報垃圾留言]

[1]

这个有什么用途呢? `:(


[引用] | 作者 清风 | 25th Nov 2005 21:40 PM | [舉報垃圾留言]