Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Ağustos 2012 Çarşamba

MS Office® Speech [2]


'UserForm1


'A. Available 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: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL
'4) Name: MSComctlLib, Description: Microsoft Windows Common Controls 6.0 (SP6), FullPath: C:\WINDOWS\system32\MSCOMCTL.OCX
'5) Name: SpeechLib, Description: Microsoft Speech Object Library, FullPath: C:\PROGRA~1\COMMON~1\MICROS~1\Speech\sapi.dll
'6) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\mso.dll
'7) Name: AUDIOCONTROLLib, Description: AudioControl ActiveX Control module, FullPath: C:\Program Files\ahead\Nero\WaveEditor\AudioControl.ocx
'8) Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, Slider1, Label4, Slider2, Label5, ComboBox1, ComboBox2, CheckBox1, CommandButton1, CommandButton2, TreeView1, CommandButton3, CommandButton4
'3) Label6, TextBox1, ProgressBar1
Option Explicit
Private i As Single
Private ii As Single
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private hwnd As Long
Private hProgress As Long
Private WithEvents hSpeech As SpeechLib.SpVoice
Private sSpeech As SpeechLib.SpFileStream
Private hRow As Double
Private hAttributes As String
Private hID As Double
Private hSpeeker As SpeechLib.ISpeechObjectToken
Private hAudio As SpeechLib.SpObjectToken
Private hSpeekerNo As Double
Private hMale As Double
Private hFemale As Double
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] MS Office® Speech [2]"
hwnd = FindWindow(vbNullString, Me.Caption)
Set hSpeech = New SpVoice
hSpeech.AlertBoundary = SVEPhoneme
Call Ekran_Kur
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
hRow = ComboBox1.ListIndex
hAttributes = "Gender=" & ComboBox1.List(hRow, 1)
hID = ComboBox1.List(hRow, 6)
Set hSpeech = Nothing
Set hSpeech = New SpeechLib.SpVoice
Set hSpeech.Voice = hSpeech.GetVoices(hAttributes).Item(hID)
CommandButton1.Caption = "Start"
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
With CommandButton1
Select Case .Caption
Case "Start"
Call hSpeech_Situation
If CheckBox1 = False Then
.Caption = "Pause"
Slider1.Enabled = False
Slider2.Enabled = False
ComboBox1.Enabled = False
CommandButton1.Picture = Resim(URL4)
Else
CommandButton1.Caption = "Start"
Slider1.Enabled = True
Slider2.Enabled = True
ComboBox1.Enabled = True
CheckBox1.Value = False
CommandButton1.Picture = Resim(URL3)
End If
Case "Pause"
hSpeech.Pause
.Caption = "Resume"
Slider1.Enabled = True
Slider2.Enabled = True
ComboBox1.Enabled = True
CommandButton1.Picture = Resim(URL3)
Case "Resume"
hSpeech.Resume
.Caption = "Pause"
Slider1.Enabled = False
Slider2.Enabled = False
ComboBox1.Enabled = False
CommandButton1.Picture = Resim(URL4)
End Select
End With
VBA.DoEvents
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Set hSpeech = Nothing
CommandButton1.Caption = "Start"
Slider1.Enabled = True
Slider2.Enabled = True
ComboBox1.Enabled = True
CommandButton1.Picture = Resim(URL3)
Set hSpeech = New SpeechLib.SpVoice
Set hSpeech.Voice = hSpeech.GetVoices(hAttributes).Item(hID)
hSpeech.AlertBoundary = SVEPhoneme
VBA.DoEvents
End Sub
Private Sub CommandButton3_Click()
On Error Resume Next
If hSpeech.IsUISupported(SpeechAudioVolume) = True Then
hSpeech.DisplayUI hwnd, "", SpeechAudioVolume, ""
End If
End Sub
Private Sub CommandButton4_Click()
On Error Resume Next
Call hSpeech_SVSFile
End Sub
Private Sub Slider1_Change()
On Error Resume Next
hSpeech.Volume = Slider1.Value
VBA.DoEvents
hSpeech.Rate = Slider2.Value
VBA.DoEvents
End Sub
Private Sub Slider2_Change()
On Error Resume Next
hSpeech.Volume = Slider1.Value
VBA.DoEvents
hSpeech.Rate = Slider2.Value
VBA.DoEvents
End Sub
Private Sub hSpeech_Situation()
On Error Resume Next
If CheckBox1.Value = False Then
hSpeech.Speak TextBox1.Text, SVSFlagsAsync
Else
Set sSpeech = New SpFileStream
Call sSpeech.Open(ThisWorkbook.Path & "\SpeakStream.wav", SSFMCreateForWrite, False)
Set hSpeech.AudioOutputStream = sSpeech
hSpeech.Speak TextBox1.Text, SVSFNLPSpeakPunc
sSpeech.Close
'Call sSpeech.Open(ThisWorkbook.Path & "\SpeakStream.wav", SSFMOpenForRead, False)

Call VBA.Shell("mplay32.exe /Play " & ThisWorkbook.Path & "\SpeakStream.wav", vbNormalFocus)
End If
End Sub
Private Sub hSpeech_SVSFile()
On Error Resume Next
Open ThisWorkbook.Path & "\Ses.txt" For Output As #1
Print #1, TextBox1.Text
Close #1
hSpeech.Speak ThisWorkbook.Path & "\Ses.txt", SVSFIsFilename + SVSFlagsAsync
End Sub
Private Sub hSpeech_EndStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
End With
CommandButton1.Caption = "Start"
Slider1.Enabled = True
Slider2.Enabled = True
ComboBox1.Enabled = True
CommandButton1.Picture = Resim(URL3)
DestroyWindow hProgress
End Sub
Private Sub hSpeech_AudioLevel(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal AudioLevel As Long)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key3").Text = "AudioLevel: " & AudioLevel
End With
End Sub
Private Sub hSpeech_Bookmark(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal Bookmark As String, ByVal BookmarkId As Long)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key4").Text = "Bookmark: " & Bookmark
.Nodes("Key5").Text = "BookmarkId: " & BookmarkId
End With
End Sub
Private Sub hSpeech_EnginePrivate(ByVal StreamNumber As Long, ByVal StreamPosition As Long, ByVal EngineData As Variant)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key6").Text = "EngineData: " & EngineData
End With
End Sub
Private Sub hSpeech_Phoneme(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal Duration As Long, ByVal NextPhoneId As Integer, ByVal Feature As SpeechLib.SpeechVisemeFeature, ByVal CurrentPhoneId As Integer)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key7").Text = "Duration: " & Duration
.Nodes("Key8").Text = "NextPhoneId: " & NextPhoneId
.Nodes("Key9").Text = "Feature: " & Feature
.Nodes("Key10").Text = "CurrentPhoneId: " & CurrentPhoneId
End With
End Sub
Private Sub hSpeech_Sentence(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key11").Text = "CharacterPosition: " & CharacterPosition
.Nodes("Key12").Text = "Length: " & Length
End With
End Sub
Private Sub hSpeech_StartStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
End With
End Sub
Private Sub hSpeech_Viseme(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal Duration As Long, ByVal NextVisemeId As SpeechLib.SpeechVisemeType, ByVal Feature As SpeechLib.SpeechVisemeFeature, ByVal CurrentVisemeId As SpeechLib.SpeechVisemeType)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key7").Text = "Duration: " & Duration
.Nodes("Key9").Text = "Feature: " & Feature
.Nodes("Key13").Text = "NextVisemeId: " & NextVisemeId
.Nodes("Key14").Text = "CurrentVisemeId: " & CurrentVisemeId
End With
End Sub
Private Sub hSpeech_VoiceChange(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal VoiceObjectToken As SpeechLib.ISpeechObjectToken)
On Error Resume Next
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key15").Text = "VoiceObjectToken: " & VoiceObjectToken
End With
End Sub
Private Sub hSpeech_Word(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)
On Error Resume Next
TextBox1.SetFocus
TextBox1.SelStart = CharacterPosition
TextBox1.SelLength = Length
With TreeView1
.Nodes("Key1").Text = "StreamNumber: " & StreamNumber
.Nodes("Key2").Text = "StreamPosition: " & StreamPosition
.Nodes("Key11").Text = "CharacterPosition: " & CharacterPosition
.Nodes("Key12").Text = "Length: " & Length
End With
hSpeech.Volume = Slider1.Value
VBA.DoEvents
hSpeech.Rate = Slider2.Value
VBA.DoEvents
If TextBox1.TextLength > 0 Then ProgressBar1.Value = 100 * CharacterPosition / TextBox1.TextLength
SendMessage hProgress, &H402, 100 - VBA.Val(100 * CharacterPosition / TextBox1.TextLength), 0&
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Width = 564
.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 Label3
.Top = 36
.Left = 6
.Height = 12
.Width = 126
.BorderColor = VBA.RGB(200, 200, 200)
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.Caption = "Volume"
.TextAlign = fmTextAlignCenter
.ForeColor = &H808000
.BackStyle = fmBackStyleTransparent
End With
With Slider1
.Left = 6
.Top = 48
.Height = 24
.Width = 126
.Min = 0
.Max = 100
.Value = 60
.BorderStyle = ccNone
.SmallChange = 1
.TickFrequency = 5
End With
With Label4
.Top = 72
.Left = 6
.Height = 12
.Width = 126
.BorderColor = VBA.RGB(200, 200, 200)
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.Caption = "Rate"
.TextAlign = fmTextAlignCenter
.ForeColor = &H808000
.BackStyle = fmBackStyleTransparent
End With
With Slider2
.Left = 6
.Top = 84
.Height = 24
.Width = 126
.Min = -10
.Max = 10
.Value = 0
.BorderStyle = ccNone
.SmallChange = 1
.TickFrequency = 1
End With
With Label5
.Top = 108
.Left = 6
.Height = 12
.Width = 126
.BorderColor = VBA.RGB(200, 200, 200)
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.Caption = "Speaker & AudioOutput"
.TextAlign = fmTextAlignCenter
.ForeColor = &H808000
.BackStyle = fmBackStyleTransparent
End With
With ComboBox1
.Left = 6
.Top = 120
.Height = 18
.Width = 126
.ColumnCount = 6
.ColumnWidths = "114;0;0;0;0;0;0"
hSpeekerNo = 0
hMale = -1
hFemale = -1
For Each hSpeeker In hSpeech.GetVoices
.AddItem hSpeeker.GetAttribute("Name")
.List(hSpeekerNo, 1) = hSpeeker.GetAttribute("Gender")
.List(hSpeekerNo, 3) = hSpeeker.GetAttribute("Language")
.List(hSpeekerNo, 5) = hSpeeker.ID
If hSpeeker.GetAttribute("Gender") = "Male" Then
hMale = hMale + 1
.List(hSpeekerNo, 6) = hMale
Else
hFemale = hFemale + 1
.List(hSpeekerNo, 6) = hFemale
End If
hSpeekerNo = hSpeekerNo + 1
Next
.ListIndex = 0
.BorderStyle = fmBorderStyleSingle
.BorderColor = VBA.RGB(200, 200, 200)
.ForeColor = &H808000
End With
With ComboBox2
.Left = 6
.Top = ComboBox1.Top + ComboBox1.Height
.Height = 18
.Width = 126
.ColumnCount = 6
.ColumnWidths = "114;0;0;0;0;0;0"
hSpeekerNo = 0
hMale = -1
hFemale = -1
Set hAudio = hSpeech.AudioOutput
For Each hAudio In hSpeech.GetAudioOutputs
.AddItem hAudio.GetDescription
Next hAudio
.ListIndex = 0
.BorderStyle = fmBorderStyleSingle
.BorderColor = VBA.RGB(200, 200, 200)
.ForeColor = &H808000
End With
With CheckBox1
.Left = 6
.Top = ComboBox2.Top + ComboBox2.Height + 6
.Height = 18
.Width = 126
.Caption = "SSFMCreateForWrite"
.Value = False
.SpecialEffect = fmButtonEffectSunken
.Alignment = fmAlignmentRight
.AutoSize = False
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With CommandButton1
.Left = 6
.Top = CheckBox1.Top + CheckBox1.Height + 6
.Height = 24
.Width = 60
.Caption = "Start"
.BackStyle = fmBackStyleTransparent
.Picture = Resim(URL3)
.PicturePosition = fmPicturePositionLeftCenter
.ForeColor = &H808000
End With
With CommandButton2
.Left = 72
.Top = CheckBox1.Top + CheckBox1.Height + 6
.Height = 24
.Width = 60
.Caption = "Stop"
.BackStyle = fmBackStyleTransparent
.Picture = Resim(URL5)
.PicturePosition = fmPicturePositionLeftCenter
.ForeColor = &H808000
End With
With TreeView1
.Left = 6
.Top = CommandButton1.Top + CommandButton1.Height + 6
.Height = 181.5
.Width = 126
.Nodes.Add , , "Key1", "StreamNumber: "
.Nodes.Add , , "Key2", "StreamPosition: "
.Nodes.Add , , "Key3", "AudioLevel: "
.Nodes.Add , , "Key4", "Bookmark: "
.Nodes.Add , , "Key5", "BookmarkId: "
.Nodes.Add , , "Key6", "EngineData: "
.Nodes.Add , , "Key7", "Duration: "
.Nodes.Add , , "Key8", "NextPhoneId: "
.Nodes.Add , , "Key9", "Feature: "
.Nodes.Add , , "Key10", "CurrentPhoneId: "
.Nodes.Add , , "Key11", "CharacterPosition: "
.Nodes.Add , , "Key12", "Length: "
.Nodes.Add , , "Key13", "NextVisemeId: "
.Nodes.Add , , "Key14", "CurrentVisemeId: "
.Nodes.Add , , "Key15", "VoiceObjectToken: "
.Appearance = ccFlat
.BorderStyle = ccFixedSingle
.LineStyle = tvwTreeLines
.Indentation = 6
.FullRowSelect = True
For i = 1 To 15
.Nodes(i).BackColor = vbBlack
.Nodes(i).ForeColor = vbGreen
Next i
End With
With CommandButton3
.Left = 6
.Top = TreeView1.Top + TreeView1.Height + 6
.Height = 24
.Width = 126
.Caption = "SpeechAudioVolume"
.BackStyle = fmBackStyleTransparent
.Picture = Resim(URL6)
.PicturePosition = fmPicturePositionLeftCenter
.ForeColor = &H808000
End With
With CommandButton4
.Left = 6
.Top = CommandButton3.Top + CommandButton3.Height + 6
.Height = 24
.Width = 126
.Caption = "SVSFIsFilename"
.BackStyle = fmBackStyleTransparent
.Picture = Resim(URL3)
.PicturePosition = fmPicturePositionLeftCenter
.ForeColor = &H808000
End With
With Label6
.Top = 36
.Left = 138
.Height = 12
.Width = 414
.BorderColor = VBA.RGB(200, 200, 200)
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
hSpeech.EventInterests = hSpeech.EventInterests Or SVEPhoneme
.Caption = "Speaker Text EventInterest: " & hSpeech.EventInterests & ", SVEPhoneme: " & SVEPhoneme & ", SVEViseme: " & SVEViseme
.TextAlign = fmTextAlignCenter
.ForeColor = &H808000
.BackStyle = fmBackStyleTransparent
End With
With TextBox1
.Left = 138
.Top = 48
.Height = CommandButton4.Top + CommandButton4.Height - .Top - 6 - 24
.Width = 414
.MultiLine = True
.AutoWordSelect = True
.BackColor = &HF5F5F5
.BackStyle = fmBackStyleOpaque
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.ForeColor = vbBlue
.Text = "The first speech recognizer appeared in 1952 and consisted of a device "
.Text = .Text & "for the recognition of single spoken digits [1]. Another early device was the IBM Shoebox, "
.Text = .Text & "exhibited at the 1964 New York World's Fair. One of the most notable domains for the "
.Text = .Text & "commercial application of speech recognition in the United States has been health care and "
.Text = .Text & "in particular the work of the medical transcriptionist (MT)[citation needed]. "
.Text = .Text & "According to industry experts, at its inception, speech recognition (SR) was sold as a way to "
.Text = .Text & "completely eliminate transcription rather than make the transcription process more efficient, "
.Text = .Text & "hence it was not accepted. It was also the case that SR at that time was often technically deficient. "
.Text = .Text & "Additionally, to be used effectively, it required changes to the ways physicians worked and "
.Text = .Text & "documented clinical encounters, which many if not all were reluctant to do. The biggest "
.Text = .Text & "limitation to speech recognition automating transcription, however, is seen as the software. "
.Text = .Text & "The nature of narrative dictation is highly interpretive and often requires judgment that may be "
.Text = .Text & "provided by a real human but not yet by an automated system. Another limitation has been the extensive "
.Text = .Text & "amount of time required by the user and/or system provider to train the software. "
.Text = .Text & "A distinction in ASR is often made between artificial syntax systems, which are usually domain-specific, "
.Text = .Text & "and natural language processing, which is usually language-specific. "
.Text = .Text & "Each of these types of application presents its own particular goals and challenges."
.Font.Name = "Arial"
.Font.Size = 12
.ScrollBars = fmScrollBarsVertical
End With
With ProgressBar1
.Left = 138
.Top = TextBox1.Top + TextBox1.Height + 6
.Height = 12
.Width = 414
.Appearance = cc3D
.BorderStyle = ccNone
.Enabled = False
.Orientation = ccOrientationHorizontal
SendMessage .hwnd, (&H400 + 9), 0&, ByVal vbGreen 'Bar Çubuk
SendMessage .hwnd, (&H2000& + 1), 0&, ByVal vbBlack 'Bar Arkası

hProgress = CreateWindowEX(0, "MSCtls_Progress32", "", &H50000000, .Left / 0.748, .Top / 0.748 + 14, .Width / 0.748, .Height / 0.748, hwnd, 0, 0, 0) 'API Bar
SetParent hProgress, hwnd
End With
.Height = CommandButton4.Top + CommandButton4.Height + 6 + 24
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}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public Const URL3 As String = "http://4.bp.blogspot.com/-kykCYX4SFC8/Tq8Uu3h3fjI/AAAAAAAAC9g/4Rfj-PSSsQc/s1600/StartButton.bmp"
Public Const URL4 As String = "http://3.bp.blogspot.com/-_G_Yk_tCbbg/Tq8UtRchMHI/AAAAAAAAC9Y/I8WwlFBNTOM/s1600/PausetButton.bmp"
Public Const URL5 As String = "http://3.bp.blogspot.com/-Mw8f5RriP9U/Tq8UwPmO7II/AAAAAAAAC9o/Oef_gcMUOn0/s1600/StoptButton.bmp"
Public Const URL6 As String = "http://1.bp.blogspot.com/_hsHTxo_5L8E/S9P3ZX8GDmI/AAAAAAAACVI/tbODtxPs-Vc/s1600/Ses_bmp.bmp"
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

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

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