How do I draw a line on a form?
P.Held
What is the VBA command to draw a line on an Excel form in Excel 97 and
2000?
TIA,
P. Held
Stratos Malasiotis
In order to draw a line on a Userform you take a pen and you simply draw a line on the the Userform <g>.
The following user-form module shows a "fun" example of how you can do that.
Insert a new Userform with no controls on it. Place the following code in the respective code module.
Show the userform. If you hold your Shift button down and you Left-click on the userform an initial point for a line is specified. If you
hold the Shift down and you click the userform again a line is drawn between the two points.
Who said that Excel can not be great fun <g> !!
I know that this is not exactly what you had in mind since those lines, although they seem perfectly fine, are not persistant. Every action
that will cause the userform to repaint itself will delete these lines. The obvious workaround would be two keep all the lines in
acollection and redraw them in Userform_ActivateSystem event that unfortuanately doesn't exist. You'll need to sub-class the form and that
is a bad idea.
Alternatively you could use a Frame control to draw horizontal and vertical lines only.
HTH
Stratos
--------------------------------------------------------------------
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) _
As Long
Private Declare Function GetDC _
Lib "user32" _
( _
ByVal hwnd As Long _
) _
As Long
Private Declare Function CreatePen _
Lib "gdi32" _
( _
ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long _
) _
As Long
Private Declare Function SelectObject _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal hObject As Long _
) _
As Long
Private Declare Function LineTo _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long _
) _
As Long
Private Declare Function MoveToEx _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long, _
lpPoint As POINTAPI _
) _
As Long
Private Declare Function ScreenToClient _
Lib "user32" _
( _
ByVal hwnd As Long, _
lpPoint As POINTAPI _
) _
As Long
Private Declare Function GetCursorPos _
Lib "user32" _
( _
lpPoint As POINTAPI _
) _
As Long
'module level variable declarations
Private aFlag As Boolean
Private Me_hWnd As Long
Private StartLineat_XPoint As Long
Private StartLineat_YPoint As Long
Private EndLineat_XPoint As Long
Private EndLineat_YPoint As Long
Private Function fncDrawLineonForm _
( _
Optional LineWidth As Long = 1, _
Optional LineColor As Long = 0 _
)
'draws a line of the specified color and width between the points
'defined by two consequetive mouse clicks with the shift button down
'variable declarations
Dim Me_DC As Long
Dim aWinPen As Long, aCustomPen As Long
Dim aScreenPoint As POINTAPI
'get a handle to the DC of the client area of the userform
Me_DC = GetDC _
( _
hwnd:=Me_hWnd _
)
'create a custom Pen for drawing the line
aCustomPen = CreatePen _
( _
nPenStyle:=0, _
nWidth:=LineWidth, _
crColor:=LineColor _
)
'assign this new Pen to the DC of the userform
aWinPen = SelectObject _
( _
hdc:=Me_DC, _
hObject:=aCustomPen _
)
'set the starting point of the line
Call MoveToEx _
( _
hdc:=Me_DC, _
X:=StartLineat_XPoint, _
Y:=StartLineat_YPoint, _
lpPoint:=aScreenPoint _
)
'draw the line from the starting to the ending point
Call LineTo _
( _
hdc:=Me_DC, _
X:=EndLineat_XPoint, _
Y:=EndLineat_YPoint _
)
'restore the default pen to the userform DC
Call SelectObject _
( _
hdc:=Me_DC, _
hObject:=aWinPen _
)
End Function
Private Sub UserForm_Activate()
'get a handle to the userform window, that can be used during the drawing session
Me_hWnd = FindWindow _
( _
lpClassName:=IIf(Val(Application.Version) > 8, _
"ThunderDFrame", _
"ThunderXFrame"), _
lpWindowName:=Me.Caption _
)
End Sub
Private Sub UserForm_MouseDown _
( _
ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single _
)
'variable declarations
Dim aScreenPoint As POINTAPI
'get the position of the cursor, at screen coordinates at the
'moment the mouse was clicked
Call GetCursorPos _
( _
lpPoint:=aScreenPoint _
)
'convert the coordinated of the mouse cursor position
'from screen-level to UserForm-level
'(not the same with X and Y values of the event)
Call ScreenToClient _
( _
hwnd:=Me_hWnd, _
lpPoint:=aScreenPoint _
)
'assign the cursor coordinates to the starting and ending points
'of the line-to-draw, when the required conditions are satisfied
If CBool(Shift) = True Then
If Button = 1 Then
If aFlag = False Then
StartLineat_XPoint = aScreenPoint.X
StartLineat_YPoint = aScreenPoint.Y
aFlag = True
Else
EndLineat_XPoint = aScreenPoint.X
EndLineat_YPoint = aScreenPoint.Y
aFlag = False
'at that point we have the 'start' and 'end' coordinates of the
'line and we can draw it
Call fncDrawLineonForm _
( _
LineWidth:=3, _
LineColor:=vbBlue _
)
End If
End If
End If
End Sub
-------------------------------------------------------------------------