Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

21 Haziran 2011 Salı

Clear Event Log Function

'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) İmage1
'2) Label1
'3) Label2
'4) Label3, Label4, Label5, Label6, Label7, Label8, Label9, Label10
'5) CommandButton1
Private Const EVENTLOG_SUCCESS = &H0
Private Const EVENTLOG_ERROR_TYPE = &H1
Private Const EVENTLOG_WARNING_TYPE = &H2
Private Const EVENTLOG_INFORMATION_TYPE = &H4
Private Const EVENTLOG_AUDIT_SUCCESS = &H8
Private Const EVENTLOG_AUDIT_FAILURE = &H10
Private Const EVENTLOG_SEQUENTIAL_READ = &H1
Private Const EVENTLOG_SEEK_READ = &H2
Private Const EVENTLOG_FORWARDS_READ = &H4
Private Const EVENTLOG_BACKWARDS_READ = &H8
Private Type EVENTLOGRECORD
Length As Long ' Length of full record Reserved As Long ' Used by the service RecordNumber As Long ' Absolute record number TimeGenerated As Long ' Seconds since 1-1-1970 TimeWritten As Long 'Seconds since 1-1-1970 EventID As Long
EventType As Integer
NumStrings As Integer
EventCategory As Integer
ReservedFlags As Integer ' For use with paired events (auditing) ClosingRecordNumber As Long 'For use with paired events (auditing)
StringOffset As Long ' Offset from beginning of record UserSidLength As Long
UserSidOffset As Long
DataLength As Long
DataOffset As Long ' Offset from beginning of record
End Type
Private ELR As EVENTLOGRECORD
Private Declare Function OpenEventLog Lib "advapi32.dll" Alias "OpenEventLogA" (ByVal lpUNCServerName As String, ByVal lpSourceName As String) As Long
Private Declare Function CloseEventLog Lib "advapi32.dll" (ByVal hEventLog As Long) As Long
Private Declare Function BackupEventLog Lib "advapi32.dll" Alias "BackupEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long
Private Declare Function ClearEventLog Lib "advapi32.dll" Alias "ClearEventLogA" (ByVal hEventLog As Long, ByVal lpBackupFileName As String) As Long
Private Declare Function GetNumberOfEventLogRecords Lib "advapi32.dll" (ByVal hEventLog As Long, NumberOfRecords As Long) As Long
Private Declare Function GetOldestEventLogRecord Lib "advapi32.dll" (ByVal hEventLog As Long, OldestRecord As Long) As Long
Private Declare Function ReportEvent Lib "advapi32.dll" Alias "ReportEventA" (ByVal hEventLog As Long, ByVal wType As Long, ByVal wCategory As Long, ByVal dwEventID As Long, lpUserSid As Any, ByVal wNumStrings As Long, ByVal dwDataSize As Long, lpStrings As String, lpRawData As Any) As Long
Private LogEvents As Long
Private LogReturn As Long
Private LogAddress As String
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Clear Event Log Function"
Call Ekran_Duzenle
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
LogAddress = "C:\Users\Public\LogReport.bak"
Label4.Caption = LogAddress
LogEvents = OpenEventLog(vbNullString, LogAddress)
Label6.Caption = LogEvents
ClearEventLog LogEvents, vbNullString
ReportEvent LogEvents, EVENTLOG_INFORMATION_TYPE, 0, 0, ByVal 0&, 1, 0, "Log Report!", ByVal 0&
GetNumberOfEventLogRecords LogEvents, LogReturn
Label8.Caption = VBA.CStr(LogReturn)
GetOldestEventLogRecord LogEvents, LogReturn
Label10.Caption = VBA.CStr(LogReturn)
BackupEventLog LogEvents, LogAddress
CloseEventLog LogEvents
End Sub
Private Sub Ekran_Duzenle()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 166
.Width = 245
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 420
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 18
.Width = 96
.Caption = " Log File Adress"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlack
End With
With Label4
.Left = 102
.Top = 36
.Height = 18
.Width = 132
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
End With
With Label5
.Left = 6
.Top = 54
.Height = 18
.Width = 96
.Caption = " Clear Events"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlack
End With
With Label6
.Left = 102
.Top = 54
.Height = 18
.Width = 132
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
End With
With Label7
.Left = 6
.Top = 72
.Height = 18
.Width = 96
.Caption = " Events Reported"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlack
End With
With Label8
.Left = 102
.Top = 72
.Height = 18
.Width = 132
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
End With
With Label9
.Left = 6
.Top = 90
.Height = 18
.Width = 96
.Caption = " Oldest Event Record"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlack
End With
With Label10
.Left = 102
.Top = 90
.Height = 18
.Width = 132
.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = &H808000
End With
With CommandButton1
.Left = 6
.Top = 114
.Height = 24
.Width = 228
.Caption = "Clear Event Log"
.ForeColor = vbBlack
.Font.Bold = True
.BackStyle = fmBackStyleTransparent
End With
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/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
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 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

20 Haziran 2011 Pazartesi

To Read The Raw (Digital Format) File System





 'UserForm1

'A) Windows XP® Office 2003® Normal Referance List
     'Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL'Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE'Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
     'Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL'Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
     'Name: DIRECTORSHOCKWAVELib, Description: Shockwave ActiveX Control, FullPath: C:\WINDOWS\system32\Adobe\Director\SwDir.dll [Picture1:1] (Ctrl + T; Shockwave ActiveX Control)
'B) UserForm1'e Eklenen Araçlar (Add Tools)
     'Image1, Label1, Label2
     'ShockwaveCtl1 [Picture:2]
'C) Raw Image Format (
http://en.wikipedia.org/wiki/Raw_image_format)
     'ADOBE [*.dng]
     'ARRIFLEX [*.ari]
     'CANON [*.crw, *.cr2]
     'CASIO [*.bay]
     'EPSON [*.erf]
     'FUJI [*.raf]
     'HASSELBLAD [*.3fr]
     'IMACON [*.fff]
     'KODAK [*.dcs, *.dcr, *.drf, *.k25, *.kdc, *.tif]
     'LEAF [*.mos]
     'LEICA [*.raw, *.rwl, *.dng]
     'LOGITECH [*.pxn]
     'MAMIYA [*.mef]
     'MINOLTA [*.mrw]
     'NIKON [*.nef, *.nrw]
     'OLYMPUS [*.orf]
     'PANASONIC [*.raw, *.rw2]
     'PENTAX [*.ptx, *.pef]
     'PHASE ONE [*.cap, *.tif, *.iiq, *.eip]
     'RAWZOR [*.rwz]
     'RED [*.r3d]
     'SIGMA [*.r3f]
     'SONY [*.arw, *.srf, *.sr2]

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Private 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
Private IPic(15) As Byte
Private Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}" 'It may take a few seconds, please wait.Private Const URL1 As String = "
http://2.bp.blogspot.com/_hsHTxo_5L8E/S7rn6KHVfNI/AAAAAAAACRs/fxVMg9YGzb4/s1600/VectorBackround.jpg" 'Microsoft Office Excel® Kod KılavuzuPrivate
Sub UserForm_Initialize()
     On Error Resume Next
     Dim Eleman, i
     Me.Caption = "[PBİD®]To Read The Raw (Digital Format) File System"
     Call EkranDüzenle
End Sub
Private Sub UserForm_Activate()

     On Error Resume Next
     With ShockwaveCtl1
          .AutoStart = True
          .GotoMovie .SRC
          .Play
     End With
End Sub
Private Sub UserForm_Terminate()

     On Error Resume Next
     ShockwaveCtl1.SRC = ""
End Sub
Private Function Resim(URL) As Picture

     On Error Resume Next
     CLSIDFromString StrPtr(ClsID), IPic(0)
     OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
Private Sub EkranDüzenle()

     On Error Resume Next
     With Me
          .Height = 295
          .Width = 316
          .BackColor = vbWhite
          .Picture = Resim(URL1)
          .PictureAlignment = fmPictureAlignmentTopLeft
          .PictureSizeMode = fmPictureSizeModeClip
          .PictureTiling = False
          .SpecialEffect = fmSpecialEffectFlat
          .BackColor = vbWhite
          With Image1
                .BackStyle = fmBackStyleTransparent
                .BorderColor = &HFF0000
                .BorderStyle = fmBorderStyleSingle
                .Top = 6
                .Left = 6
                .Height = 24
                .Width = 24
                .Picture = LoadPicture("C:\Documents and Settings\ULUSARAÇ\Belgelerim\Mustafa ULUSARAÇ\ExcelÖrnekler\PBİD.ico")
          End With
          With Label1
               .Caption = " " & "Mustafa ULUSARAÇ"
               .BackStyle = fmBackStyleTransparent
               .BorderStyle = fmBorderStyleNone
               .SpecialEffect = fmSpecialEffectFlat
               .Left = 30
               .Top = 6
               .Height = 12
               .Width = 198
               .Font.Bold = True
               .ForeColor = &HFF0000
          End With
          With Label2
               .Caption = " " & "
01ulusarac@superonline.com"
               .BackStyle = fmBackStyleTransparent
               .BorderStyle = fmBorderStyleNone
               .SpecialEffect = fmSpecialEffectFlat
               .Left = 30
               .Top = 18
               .Height = 12
               .Width = 198
               .Font.Bold = True
               .ForeColor = &HFF0000
          End With
          With ShockwaveCtl1
               '.SRC = "C:\WINDOWS\system32\Adobe\Shockwave 11\shockwave_Projector_Loader.dcr"
               .SRC = "
http://static.howstuffworks.com/director/paintball-gun.dcr"
               .Top = 36
               .Left = 6
               .Width = 300
               .Height = 229
          End With
     End With
End Sub

10 Haziran 2011 Cuma

Browse For Folder Functions

'UserForm1

'A References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\mso.dll
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'B Additional Tolls List
'Image1, Label1, label2
'CommandButton1
'TextBox1
Option Explicit
Private GetFolderName As String
Private IStyle As Long
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®]Browse For Folder Functions"
Call Ekran_Duzenle
TextBox1.Text = VBA.CurDir
UFhWnd = FindWindow("ThunderDFrame", Me.Caption)
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
GetFolderName = Folder_Browse(UFhWnd, "Select your folder", TextBox1.Text)
If VBA.Len(GetFolderName) = 0 Then Exit Sub
TextBox1.Text = GetFolderName
VBA.ChDrive VBA.Split(TextBox1.Text, "\")(0)
VBA.ChDir TextBox1.Text
End Sub
Private Sub Ekran_Duzenle()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 92
.Width = 522
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 318
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 318
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With CommandButton1
.Caption = "Default Folder Chose"
.Left = 6
.Top = 36
.Height = 24
.Width = 84
End With
With TextBox1
.Left = 96
.Top = 36
.Height = 24
.Width = 414
.AutoSize = False
.BackStyle = fmBackStyleTransparent
.Locked = True
.MultiLine = True
.ScrollBars = fmScrollBarsBoth
.SpecialEffect = fmSpecialEffectEtched
.ForeColor = &H404000
.Font.Bold = True
End With
End With
End Sub


'Module1


Option Explicit
Public UFhWnd As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpFT As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private BI As BrowseInfo
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private CF As String 'Current Folder
Private FIDL As Long 'Folder ID List
Private FT As String 'Folder Title
Private FB As String 'Folder Buffer
Private RF As Long 'Folder Return
Public Function Folder_Browse(ByVal hWnd As Long, Title As String, StartDir As String) As String
On Error Resume Next
CF = StartDir & vbNullChar
FT = Title
With BI
.hWndOwner = hWnd
.lpFT = lstrcat(FT, "")
.ulFlags = 1 + 2 + &H4&
.lpfnCallback = Folder_Adress(AddressOf Browse_Procedure)
End With
FIDL = SHBrowseForFolder(BI)
If (FIDL) Then
FB = Space(260)
SHGetPathFromIDList FIDL, FB
FB = Left(FB, InStr(FB, vbNullChar) - 1)
Folder_Browse = FB
Else
Folder_Browse = ""
End If
End Function
Private Function Browse_Procedure(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
On Error Resume Next
Select Case uMsg
Case 1
Call SendMessage(hWnd, (&H400 + 102), 1, CF)
Case 2
FB = Space(260)
RF = SHGetPathFromIDList(lp, FB)
If RF = 1 Then
Call SendMessage(hWnd, (&H400 + 100), 0, FB)
End If
End Select
Browse_Procedure = 0
End Function
Private Function Folder_Adress(Additional As Long) As Long
On Error Resume Next
Folder_Adress = Additional
End Function


'Module2


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/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp" 'Microsoft Office Excel® Kod Kılavuzu [PBİD BackroundPicture]
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 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

Blog Arşivi

Gadget

Bu içerik henüz şifreli bağlantı üzerinden kullanılamıyor.

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul
Anadolu Üniversitesi Açık Öğretim Fakültesi