I need to draw lines in a UserForm. How do I do this? Line is not an option
in the Form Tool box. Or am I now seeing it? Thank you in advance for any
help you can provide.

You could do it with the Windows API:

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private dPointsPerPixel As Double
'a point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX As Long = 88 'pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'pixels/inch in Y, this is not
used
Private Const TWIPSPERINCH As Long = 1440

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const PS_DOT = 2
Private gPen As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal
hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As
Long
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function GetPixel 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 LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X As
Long, ByVal Y As Long) As Long

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub DrawLineForm(frmForm As Object, _
bVertical As Boolean, _
lXVertical As Long, _
lYHorizontal As Long, _
lFromEdge1 As Long, _
lFromEdge2 As Long, _
lPenType As Long, _
lPenWidth As Long, _
ByVal lPenColour As Long, _
bDoRepaint As Boolean, _
Optional lHwnd As Long = -1)

Dim hDC As Long
Dim pCoord As POINTAPI
Dim lFormRightEdge As Long
Dim lFormBottomEdge As Long
Dim lXVerticalNew As Long
Dim lYHorizontalNew As Long
Dim lFromEdge1New As Long
Dim lFromEdge2New As Long

lFormRightEdge = frmForm.InsideWidth / dPointsPerPixel
lFormBottomEdge = frmForm.InsideHeight / dPointsPerPixel
lFromEdge1New = lFromEdge1 / dPointsPerPixel
lFromEdge2New = lFromEdge2 / dPointsPerPixel
lXVerticalNew = lXVertical / dPointsPerPixel
lYHorizontalNew = lYHorizontal / dPointsPerPixel

If bDoRepaint Then
frmForm.Repaint
End If

If lHwnd = -1 Then
lHwnd = FindWindow(vbNullString, frmForm.Caption)
End If

hDC = GetDC(lHwnd)

'Create the pen
gPen = CreatePen(lPenType, lPenWidth, lPenColour)

'Select the pen onto the DC, deleting the old one
DeleteObject SelectObject(hDC, gPen)

If bVertical Then
'Move the drawing position
pCoord.X = lXVerticalNew
pCoord.Y = lFromEdge1New
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lXVerticalNew, lFormBottomEdge - lFromEdge2New
Else
'Move the drawing position
pCoord.X = lFromEdge1New
pCoord.Y = lYHorizontalNew
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lFormRightEdge - lFromEdge2New, lYHorizontalNew
End If

End Sub

Sub DeletePen()
DeleteObject gPen
End Sub

Function PointsPerPixel() As Double

'will give the size of a pixel in points
'this will be the same factor for X and Y
'for the screen, but not always for the printer
'----------------------------------------------
Dim hDC As Long
Dim lDotsPerInch As Long

hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC

End Function


RBS


"TotallyConfused" wrote in
message ...
I need to draw lines in a UserForm. How do I do this? Line is not an
option
in the Form Tool box. Or am I now seeing it? Thank you in advance for
any
help you can provide.

Surprising, isn't it, that VBA/MSFORMS doesn't provide what must be
the simplest control that could possibly be designed. If I need a line
in a userform, I just use a Frame control, setting the caption to an
empty string, sizing it to as thick as I want the line and changing
the border style and back color to make it look good.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

On Thu, 24 Sep 2009 13:43:02 -0700, TotallyConfused
wrote:

I need to draw lines in a UserForm. How do I do this? Line is not an option
in the Form Tool box. Or am I now seeing it? Thank you in advance for any
help you can provide.

Yikes!!! Do I need to enter all this code into my UserForm for a few lines?
Is this the only way?

"RB Smissaert" wrote:

You could do it with the Windows API:

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private dPointsPerPixel As Double
'a point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX As Long = 88 'pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'pixels/inch in Y, this is not
used
Private Const TWIPSPERINCH As Long = 1440

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const PS_DOT = 2
Private gPen As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal
hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long) As
Long
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function GetPixel 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 LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X As
Long, ByVal Y As Long) As Long

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub DrawLineForm(frmForm As Object, _
bVertical As Boolean, _
lXVertical As Long, _
lYHorizontal As Long, _
lFromEdge1 As Long, _
lFromEdge2 As Long, _
lPenType As Long, _
lPenWidth As Long, _
ByVal lPenColour As Long, _
bDoRepaint As Boolean, _
Optional lHwnd As Long = -1)

Dim hDC As Long
Dim pCoord As POINTAPI
Dim lFormRightEdge As Long
Dim lFormBottomEdge As Long
Dim lXVerticalNew As Long
Dim lYHorizontalNew As Long
Dim lFromEdge1New As Long
Dim lFromEdge2New As Long

lFormRightEdge = frmForm.InsideWidth / dPointsPerPixel
lFormBottomEdge = frmForm.InsideHeight / dPointsPerPixel
lFromEdge1New = lFromEdge1 / dPointsPerPixel
lFromEdge2New = lFromEdge2 / dPointsPerPixel
lXVerticalNew = lXVertical / dPointsPerPixel
lYHorizontalNew = lYHorizontal / dPointsPerPixel

If bDoRepaint Then
frmForm.Repaint
End If

If lHwnd = -1 Then
lHwnd = FindWindow(vbNullString, frmForm.Caption)
End If

hDC = GetDC(lHwnd)

'Create the pen
gPen = CreatePen(lPenType, lPenWidth, lPenColour)

'Select the pen onto the DC, deleting the old one
DeleteObject SelectObject(hDC, gPen)

If bVertical Then
'Move the drawing position
pCoord.X = lXVerticalNew
pCoord.Y = lFromEdge1New
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lXVerticalNew, lFormBottomEdge - lFromEdge2New
Else
'Move the drawing position
pCoord.X = lFromEdge1New
pCoord.Y = lYHorizontalNew
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lFormRightEdge - lFromEdge2New, lYHorizontalNew
End If

End Sub

Sub DeletePen()
DeleteObject gPen
End Sub

Function PointsPerPixel() As Double

'will give the size of a pixel in points
'this will be the same factor for X and Y
'for the screen, but not always for the printer
'----------------------------------------------
Dim hDC As Long
Dim lDotsPerInch As Long

hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC

End Function


RBS


"TotallyConfused" wrote in
message ...
I need to draw lines in a UserForm. How do I do this? Line is not an
option
in the Form Tool box. Or am I now seeing it? Thank you in advance for
any
help you can provide.

Thank you verymuch. Appreciate very much all your help.

"Chip Pearson" wrote:

Surprising, isn't it, that VBA/MSFORMS doesn't provide what must be
the simplest control that could possibly be designed. If I need a line
in a userform, I just use a Frame control, setting the caption to an
empty string, sizing it to as thick as I want the line and changing
the border style and back color to make it look good.

Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

On Thu, 24 Sep 2009 13:43:02 -0700, TotallyConfused
wrote:

I need to draw lines in a UserForm. How do I do this? Line is not an option
in the Form Tool box. Or am I now seeing it? Thank you in advance for any
help you can provide.

That the API method involves so many lines of code is no problem at all as
you can copy and paste the posted code.
You can put the API code somewhere in a .bas module and forget about it and
you can then use it with the simple
DrawLineForm with the arguments in your form.
Adding something like a very narrow frame is simpler, but if there are a
lots of lines it will take up more resources.
The API way will probably give you more control. So both methods have their
pro and cons, it just depends.

RBS


"TotallyConfused" wrote in
message ...
Yikes!!! Do I need to enter all this code into my UserForm for a few
lines?
Is this the only way?

"RB Smissaert" wrote:

You could do it with the Windows API:

Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private dPointsPerPixel As Double
'a point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Private Const LOGPIXELSX As Long = 88 'pixels/inch in X
Private Const LOGPIXELSY As Long = 90 'pixels/inch in Y, this is
not
used
Private Const TWIPSPERINCH As Long = 1440

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Const PS_SOLID = 0
Private Const PS_DASH = 1
Private Const PS_DASHDOT = 3
Private Const PS_DASHDOTDOT = 4
Private Const PS_DOT = 2
Private gPen As Long

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long,
ByVal
hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, _
ByVal nIndex As Long)
As
Long
Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function GetPixel 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 LineTo Lib "gdi32" (ByVal hDC As Long, ByVal X
As
Long, ByVal Y As Long) As Long

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub DrawLineForm(frmForm As Object, _
bVertical As Boolean, _
lXVertical As Long, _
lYHorizontal As Long, _
lFromEdge1 As Long, _
lFromEdge2 As Long, _
lPenType As Long, _
lPenWidth As Long, _
ByVal lPenColour As Long, _
bDoRepaint As Boolean, _
Optional lHwnd As Long = -1)

Dim hDC As Long
Dim pCoord As POINTAPI
Dim lFormRightEdge As Long
Dim lFormBottomEdge As Long
Dim lXVerticalNew As Long
Dim lYHorizontalNew As Long
Dim lFromEdge1New As Long
Dim lFromEdge2New As Long

lFormRightEdge = frmForm.InsideWidth / dPointsPerPixel
lFormBottomEdge = frmForm.InsideHeight / dPointsPerPixel
lFromEdge1New = lFromEdge1 / dPointsPerPixel
lFromEdge2New = lFromEdge2 / dPointsPerPixel
lXVerticalNew = lXVertical / dPointsPerPixel
lYHorizontalNew = lYHorizontal / dPointsPerPixel

If bDoRepaint Then
frmForm.Repaint
End If

If lHwnd = -1 Then
lHwnd = FindWindow(vbNullString, frmForm.Caption)
End If

hDC = GetDC(lHwnd)

'Create the pen
gPen = CreatePen(lPenType, lPenWidth, lPenColour)

'Select the pen onto the DC, deleting the old one
DeleteObject SelectObject(hDC, gPen)

If bVertical Then
'Move the drawing position
pCoord.X = lXVerticalNew
pCoord.Y = lFromEdge1New
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lXVerticalNew, lFormBottomEdge - lFromEdge2New
Else
'Move the drawing position
pCoord.X = lFromEdge1New
pCoord.Y = lYHorizontalNew
MoveToEx hDC, pCoord.X, pCoord.Y, pCoord

'Draw the line
LineTo hDC, lFormRightEdge - lFromEdge2New, lYHorizontalNew
End If

End Sub

Sub DeletePen()
DeleteObject gPen
End Sub

Function PointsPerPixel() As Double

'will give the size of a pixel in points
'this will be the same factor for X and Y
'for the screen, but not always for the printer
'----------------------------------------------
Dim hDC As Long
Dim lDotsPerInch As Long

hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC

End Function


RBS


"TotallyConfused" wrote in
message ...
I need to draw lines in a UserForm. How do I do this? Line is not an
option
in the Form Tool box. Or am I now seeing it? Thank you in advance for
any
help you can provide.