Flash Window Information

'UserForm1

'A) Normal Reference List

'A1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'A2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'A3) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\STDOLE2.TLB
'A4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'A5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'A6) Name: WMPLib, Description: Windows Media Player, FullPath: C:\WINDOWS\system32\wmp.dll

'B) Add Tools

'B1) Image1
'B2) Label1
'B3) Label2
'B4) WindowsMediaPlayer1

Option Explicit
Private Type WindowFlashInformation

cbSize As Long
hwnd As Long
dwFlags As Long
uCount As Long
dwTimeout As Long

End Type
Private WFI As WindowFlashInformation
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FlashWindowEx Lib "user32" (pfwi As WindowFlashInformation) As Boolean
Private hWind As Long
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Flash Window Information"
Call Ekran_Düzenle
hWind = FindWindow(vbNullString, Me.Caption)

End Sub
Private Sub UserForm_Activate()

On Error Resume Next
With WFI

.cbSize = Len(WFI)
.dwFlags = &H1 Or &H2 Or &H4 'Window flashing for Window Caption and TaskBar Button, until the stop flag is set.
'.dwFlags = &HC 'Window flashing until the window comes to the foreground.
'.dwFlags = 0 'Stop flashing. The system restores the window to its original state.
.dwTimeout = 0
.hwnd = hWind
.uCount = 0

End With
FlashWindowEx WFI

End Sub
Private Sub Ekran_Düzenle()

On Error Resume Next
With Me

.BackColor = vbWhite
.Height = 302
.Width = 378
.Picture = Resim(URL1)
'.Picture = LoadPicture("c:\*.bmp")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
.PictureTiling = False

End With
With Image1

.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.BackStyle = fmBackStyleTransparent
.Picture = Resim(URL2)
'.Picture = LoadPicture("c:\*.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
.Top = 6
.Left = 6
.Height = 24
.Width = 24

End With
With Label1

.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.ForeColor = vbBlue
.Font.Bold = True
.Top = 6
.Left = 36
.Height = 12
.Width = 330

End With
With Label2

.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.ForeColor = vbBlue
.Font.Bold = True
.Top = 18
.Left = 36
.Height = 12
.Width = 330

End With
With WindowsMediaPlayer1

.Top = 36
.Left = 6
.Height = 234
.Width = 360
.URL = "http://www.musiconline.com.br/somzera/videos/arq/videoclipes/CelineDion-MyHeartWillGoOn.wmv"

End With

End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'It may take a few seconds, please wait.
Public Const URL1 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg" 'Microsoft Office Excel® Kod Klavuzu [Vector Backround]
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD Icon]
Public Const URL3 As String = "http://4.bp.blogspot.com/_hsHTxo_5L8E/TKHXL1-dHVI/AAAAAAAAClo/xxJAhuSHReI/s1600/seven-shine-1024-768.jpg" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
Public URL As String
Sub Form_Aç() 'Open UserForm

On Error Resume Next
UserForm1.Show 0

End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...

On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim

End Function
'Sub References_List()

' On Error Resume Next
' Dim Eleman, No
' No = 1
' For Each Eleman In ThisWorkbook.VBProject.References

' Sheets(1).Cells(No, 1) = No & ") Name: "
' Sheets(1).Cells(No, 2) = Eleman.Name
' Sheets(1).Cells(No, 3) = ", Description: "
' Sheets(1).Cells(No, 4) = Eleman.Description
' Sheets(1).Cells(No, 5) = ", FullPath: "
' Sheets(1).Cells(No, 6) = Eleman.FullPath
' No = No + 1

' Next Eleman

'End Sub