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

FAROUK1376

عضو جديد 01
  • Posts

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

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

السمعه بالموقع

1 Neutral

عن العضو FAROUK1376

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    ممرض
  • البلد
    الجزائر
  • الإهتمامات
    برامج

اخر الزوار

بلوك اخر الزوار معطل ولن يظهر للاعضاء

  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. بارك الله فيك
  3. جزاك الله خيرا بارك الله فيك
  4. مشكل فى كود vba ارجو منكم المساعدة
×
×
  • اضف...

Important Information