TRANSICIONES ENTRE USERFORMS

[joelcg]

?Como puedo hacer una transicion interesante a los userforms de Excel tal como se hacen en PowerPoint?

Me dieron este codigo una tal Andrea pero hay algo que no acepta:

‘ EFECTO IMPLOTAR / EXPLOTAR
‘ Esto va en el modulo
#If Win16 Then
Type RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
#Else
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
#End If

#If Win16 Then
Declare Sub GetWindowRect Lib "user.dll" (ByVal hwnd As Integer, lpRect As RECT)

Declare Function GetDC Lib "user.dll" (ByVal hwnd As Integer) As Integer

Declare Function ReleaseDC Lib "user.dll" (ByVal hwnd As Integer, ByVal hdc As _
Integer) As Integer

Declare Sub SetBkColor Lib "gdi.dll" (ByVal hdc As Integer, ByVal crColor As Long)

Declare Sub Rectangle Lib "gdi.dll" (ByVal hdc As Integer, ByVal X1 As Integer, _
ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)

Declare Function CreateSolidBrush Lib "gdi.dll" (ByVal crColor As Long) As Integer

Declare Sub DeleteObject Lib "gdi.dll" (ByVal hObject As Integer)
#Else
Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, _
lpRect As RECT) As Long

Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal _
hdc As Long) As Long

Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal _
crColor As Long) As Long

Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, _
ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long

Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
#End If

‘ Module
Sub ExplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long

GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = 1 To Movement
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
DoEvents
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub

Public Sub ImplodeForm(f As Form, Movement As Integer)
Dim myRect As RECT
Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
Dim TheScreen As Long
Dim Brush As Long

GetWindowRect f.hwnd, myRect
formWidth = (myRect.Right - myRect.Left)
formHeight = myRect.Bottom - myRect.Top
TheScreen = GetDC(0)
Brush = CreateSolidBrush(f.BackColor)
For i = Movement To 1 Step -1
Cx = formWidth * (i / Movement)
Cy = formHeight * (i / Movement)
X = myRect.Left + (formWidth - Cx) / 2
Y = myRect.Top + (formHeight - Cy) / 2
Rectangle TheScreen, X, Y, X + Cx, Y + Cy
DoEvents
Next i
X = ReleaseDC(0, TheScreen)
DeleteObject (Brush)
End Sub

'Insert this code to your form:

‘ Usage
Option Explicit


Private Sub Command1_Click()
'Replace all the '500' below with the Speed of the Explode\Implode Effect.
Call ImplodeForm(Me, 500)
End
Set Form1 = Nothing
End Sub

Private Sub Form_Load()
Call ExplodeForm(Me, 500)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call ImplodeForm(Me, 500)
End Sub

 

[Greg Truby]

Esto me parece que fue escrito para otra aplicación, no Excel. ¿Tal vez Access? A pesar de eso, más o menos logré que por lo menos me arrancara con un UserForm de prueba pero la rutina ExplodeForm no me funciona porque no sé como definir f para que tenga la propiedad que busca, (f.hwnd) asi que si yo estuviera con ganas de hacer esto jugaría con las propiedades de .Zoom, .Height y .Width del formulario mismo junto con WAIT u OnTime.

Atentamente,

Greg

[PD - No hay porque gritar (usar un tipo de letra tan enorme).]

 

[Juan Pablo González]

Ese código parece estar escrito para Visual Basic (El objeto es un Form, no un Userform, y los Forms si tienen una propiedad hWnd).