FAROUK1376

Option Explicit

Private Declare PtrSafe Function GetActiveWindow Lib "USER32" () As Long

Private Declare PtrSafe Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long, _
ByVal dwNewLong As Long) As Long

Private Declare PtrSafe Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal lngWinIdx As Long) As Long

Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hWnd As Long, _
ByVal crKey As Integer, _
ByVal bAlpha As Integer, _
ByVal dwFlags As Long) As Long
   
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC

Dim hWnd            As Long
Dim Transparancy    As Integer
Dim Running         As Boolean

Private Sub CommandButton1_Click()  'Close

    Unload Me
    
End Sub
Private Sub UserForm_Activate()

    Running = True
    Call Transparency
    
End Sub
Private Sub Transparency()

Dim MyTimer         As Double

    DoEvents
    MyTimer = Timer
    Do
        Do
        Loop While Timer - MyTimer < 0.1
        MyTimer = Timer
        Transparancy = Transparancy - 1
        If Transparancy < 0 Then
            Unload Me
            Else
            Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
        End If
        DoEvents
    Loop While Running

End Sub

Private Sub SemiTransparent(ByVal intLevel As Integer)

Dim lngWinIdx       As Long

    hWnd = GetActiveWindow
    lngWinIdx = GetWindowLong(hWnd, GWL_EXSTYLE)
    SetWindowLong hWnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, 0, (255 * intLevel) / 100, LWA_ALPHA

End Sub

Private Sub UserForm_Initialize()
'Private Sub Workbook_Open()
  Dim Counter As Long, LastOpen As String, Msg As String
'Sheets("Sheet1").Activate
'Application.GoTo [A6]
'   åäÇ ááÚÏ
    Counter = GetSetting("XYZ Corp", "Budget", "Count", 0)
    LastOpen = GetSetting("XYZ Corp", "Budget", "Opened", "")
 
'   ÖÚ åäÇ ÇáãÚáæãÇÊ ÇáÊì ÊÑíÏåÇ
    STARTUP.Label10.Caption = "áÞÏ ÝÊÍ åÐÇ ÇáãáÝ  " & Counter & "  ãÑå "
    STARTUP.Label10.Caption = STARTUP.Label10.Caption & vbCrLf & "ÂÎÑ ÊÇÑíÎ Êã ÝÊÍå Ýíå åæ: " & LastOpen '''''& Format(LastOpen, "yyyy/mm/dd") & "   " & Time
'    STARTUP.Label10.Caption = STARTUP.Label10.Caption & vbCrLf & "ÇÎÑ ÊæÞíÊ Êã ÝÊÍå Ýíå åæ: "
    STARTUP.Label10.Caption = STARTUP.Label10.Caption & vbCrLf & "ÓÈÍÇä Çááå æ ÈÍãÏå , ÓÈÍÇä Çááå ÇáÚÙíã "
''    MsgBox Msg, vbInformation, ThisWorkbook.Name
    
'   áÊÍÏíË ÇáÈíÇäÇÊ
    Counter = Counter + 1
    LastOpen = Format(Date, "yyyy/mm/dd") & "   " & Time
    SaveSetting "XYZ Corp", "Budget", "Count", Counter
    SaveSetting "XYZ Corp", "Budget", "Opened", LastOpen

'''''''''''''''''''''''''''''''''''''''''''''''''

    Transparancy = 120
    Call SemiTransparent(100)
    DoEvents

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Running = False
  
End Sub
 

بارك الله فيك

جزاك الله خيرا بارك الله فيك

مشكل فى كود vba ارجو منكم المساعدة