Floating Window
Hi Paul,
You can use a no modal userform with a image control.
In UserForm module:
Option Explicit
Private Declare Function _
CloseClipboard& Lib "user32" ()
Private Declare Function _
OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function _
EmptyClipboard& Lib "user32" ()
Private Declare Function _
GetClipboardData& Lib "user32" (ByVal wFormat&)
Private Declare Function CopyEnhMetaFileA& _
Lib "gdi32" (ByVal hemfSrc&, ByVal lpszFile$)
Private Declare Function _
DeleteEnhMetaFile& Lib "gdi32.dll" (ByVal hemf&)
Private Sub UserForm_Initialize()
On Error Resume Next
Const fName$ = "c:\Range.wmf"
Const Rng$ = "A1:C6"
Me.Image1.Top = 0: Me.Image1.Left = 0
With ThisWorkbook.Sheets(1)
Me.Caption = .Name & " - " & Rng
..Range(Rng).CopyPicture
End With
OpenClipboard 0
DeleteEnhMetaFile CopyEnhMetaFileA(GetClipboardData(14), fName)
EmptyClipboard: CloseClipboard
Me.Image1.Picture = LoadPicture(fName)
Me.Image1.AutoSize = True
Dim W!: W = Me.Image1.Width
Dim H!: H = Me.Image1.Height
While Me.InsideWidth W
Me.Width = Me.Width - 1
Wend
While Me.InsideWidth < W
Me.Width = Me.Width + 1
Wend
While Me.InsideHeight H
Me.Height = Me.Height - 1
Wend
While Me.InsideHeight < H
Me.Height = Me.Height + 1
Wend
Kill fName
End Sub
In standard module:
Sub ViewRange()
UserForm1.Show 0
End Sub
Regards,
MP
"Paul Smith" a écrit dans le message de news:
...
Does anyone know of any way of producing a floating window which contains
a
view of range from a worksheet?
My requirement can be partly satisfied by using a new window, but How can
this be made to always be on top?
Any help or references gratefully received.
Paul Smith
|