RE:Dibujar LINEAS mediante código VBA
una solución es usar la API de Windows...
(en un módulo estándar)
Option Explicit
Public Const PS_SOLID As Long = 0
Public Type PointAPI
x As Long
y As Long
End Type
Declare Function apiLineTo Lib "gdi32" Alias "LineTo" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function apiFindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function apiCreatePen Lib "gdi32" Alias "CreatePen" (ByVal nPenStyle As Long, ByVal _
nWidth As Long, ByVal crColor As Long) As Long
Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As Long
Declare Function apiMoveTo Lib "gdi32" Alias "MoveToEx" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, lpPoint As PointAPI) As Long
Declare Function apiPolyline Lib "gdi32" Alias "Polyline" (ByVal hdc As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long
(en módulo del UserForm)
Option Explicit
Private Sub CommandButton1_Click()
Dim hWnd&, hdc&
Dim hPen&, hOldPen&, lpP As PointAPI
Dim x%, y%
hWnd = apiFindWindow(vbNullString, Me.Caption)
hdc = apiGetDC(hWnd)
hPen = apiCreatePen(PS_SOLID, 1, RGB(255, 0, 0))
hOldPen = apiSelectObject(hdc, hPen)
x = 50
y = 50
apiMoveTo hdc, x, y, lpP
apiLineTo hdc, x, y + 50
apiLineTo hdc, x + 50, y + 50
apiLineTo hdc, x, y
apiSelectObject hdc, hOldPen
apiDeleteObject hPen
End Sub
Private Sub CommandButton2_Click()
Dim hWnd&, hdc&
Dim hPen&, hOldPen&, lpP As PointAPI
Dim a(3) As PointAPI
hWnd = apiFindWindow(vbNullString, Me.Caption)
hdc = apiGetDC(hWnd)
hPen = apiCreatePen(PS_SOLID, 1, RGB(255, 0, 0))
hOldPen = apiSelectObject(hdc, hPen)
With a(0)
.x = 50
.y = 50
End With
With a(1)
.x = 50
.y = 100
End With
With a(2)
.x = 100
.y = 100
End With
With a(3)
.x = 50
.y = 50
End With
apiPolyline hdc, a(0), UBound(a) + 1
apiSelectObject hdc, hOldPen
apiDeleteObject hPen
End Sub
Saludos desde Baires, JuanC