Hi Amanda,

I know this isn't exactly what you're after, but it might give you a start on playing. I dug up some interesting things about our friendly office apps in this... mainly in their inconsistencies in dealing with items!

The code below will bind to the active instance of Word, Excel & Outlook. It scales Word to take up the left hand side of the screen, Excel to take up the upper right quarter, and Outlook to take the lower right corner. No, at this point it doesn't have any increase/decrease feature to it. I also haven't tested it much with multiple instances of the programs open, so I'm not sure how it will react to that.

It does use a late binding approach, and while I've only tested it from Excel, it should work from any of the office apps involved here.

The thing that is so weird is that every app has a different constant needed for the WindowState argument, and Outlook, unlike it's cousins, needs screen sizes set in pixels, not points. Just bizarre.

At any rate, here's the code to date. It has an API, so this should all go at the top of the module:

[vba]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[/vba]