'Option Explicit
'--------------- de supprimer la barre de titre "userform x" dans un userform
'----------------on ne peut plus dans ce cas déplacer le UserForm avec la souris
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
' ----------------- text défilant, voir Sub texte_défilant_USF()
Dim depart, lg
Dim Texte As String
Dim Arret As Boolean '//// modification pmo
Private Sub CommandButton1_Click()
ActiveWindow.DisplayWorkbookTabs = True ' les onglets sont affichés
info_to_put_company_name.Show ' USF is opened to put name of company
Worksheets("statistic").Select
Arret = True '//// modification pmo ???
Unload Me
End Sub
Private Sub CommandButton3_Click()
' info_début.Show
Arret = True '//// modification pmo
Unload Me
End Sub
Private Sub CommandButton4_Click()
' info_début.Show
Arret = True '//// modification pmo
Unload Me
End Sub
Private Sub CommandButton5_Click()
' info_début.Show
Arret = True '//// modification pmo
Unload Me
End Sub
Private Sub CommandButton2_Click()
CommandButton1.Visible = True
CommandButton2.Visible = False
Fin_texte_défilant_USF 'fin texte défilant Userform
End Sub
Private Sub Label6_Click() ' to close USF et fin au texte défilant de Label5
Fin_texte_défilant_USF 'fin texte défilant Userform
Arret = True '//// modification pmo
Unload Me
End Sub
Private Sub UserForm_Layout()
'Cet exemple définit la position de la boîte de dialogue et empêche de le déplacer à l'écran.
Application.ScreenUpdating = False
Me.Left = 5 'Définit la position horizontale de l'USF
Me.Top = 0 'Définit la position verticale de l'USF
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Activate() 'Cet évènement est déclenché lorsque l'UserForm est activé
activatemacro
start_texte_défilant
End Sub
Sub start_texte_défilant()
' ----------------- texte défilant dans Label5 d'un Userform -----------------
'
' -----------------on peut meme y ajouter un timer ------------------------
Me.Label5.Visible = True
For x = depart To -(4.16 * lg - depart - 1) Step -1
Me.Label5.Left = x
Me.Label5.Top = 5
w = 0.02
temp = Timer
Do While Timer < temp + w
If Arret Then Exit Do '//// modification pmo
DoEvents
Loop
Next x
UserForm_Activate
End Sub
Private Sub UserForm_Initialize()
'Me.StartUpPosition = 2 ' put the userform in center of screan
With Me
.StartUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 5
.Top = 0
End With
'de supprimer la barre de titre "userform x" dans un userform
Dim hWnd As Long, Style As Long
hWnd = FindWindow(vbNullString, Me.Caption)
Style = GetWindowLong(hWnd, -16) And Not &HC00000
SetWindowLong hWnd, -16, Style
DrawMenuBar hWnd
' ----------------- texte défilant dans Label5 d'un Userform -----------------
texte_défilant_USF
' ---------------------------------------
CommandButton1.Visible = False
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True ' 0 >> fermeture provient de la Croix du UserForm
' 1 >> fermeture provient d'une macro
End Sub
Sub texte_défilant_USF() ' le texte défilant dans Label5
Me.Label5.Width = 400
depart = Me.Label5.Left
LeTexte = " N E W V E R S I O N O F C A S H B O O K " & _
"' '" & _
" a cash book shows each day the cash fund/saldo " & _
"' '" & _
" NO MINUS CAN BE IN CASHFUND ! " & _
"' '" & _
" EVEN FOR EACH DAY " & _
". ." & _
"' '"
Me.Label5.Caption = LeTexte & LeTexte & LeTexte
lg = Len(Me.Label5.Caption)
End Sub
Sub Fin_texte_défilant_USF()
Cancel = True
End Sub
