اذهب الي المحتوي
أوفيسنا

FAROUK1376

عضو جديد 01
  • Posts

    4
  • تاريخ الانضمام

  • تاريخ اخر زياره

كل منشورات العضو FAROUK1376

  1. 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
  2. مشكل فى كود vba ارجو منكم المساعدة
×
×
  • اضف...

Important Information