Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

23 Şubat 2010 Salı

LEDMeter ActiveX Control Module


'UserForm1

'A) VBProject References List

'Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL, GUID: {000204EF-0000-0000-C000-000000000046}, Major: 4, Minor: 0
'Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE, GUID: {00020813-0000-0000-C000-000000000046}, Major:1, Minor: 5
'Name: stdole, Description: OLE Automation, FullPath: C:\WINDOWS\system32\stdole2.tlb, GUID: {00020430-0000-0000-C000-000000000046}, Major:2, Minor: 0
'Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL, GUID: {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}, Major:2, Minor: 3
'Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\WINDOWS\system32\FM20.DLL, GUID: {0D452EE1-E08F-101A-852E-02608C4D0BB4}, Major:2, Minor: 0
'Name: SpeechLib, Description: Microsoft Speech Object Library, FullPath: C:\Program Files\Common Files\Microsoft Shared\Speech\sapi.dll, GUID: {C866CA3A-32F7-11D2-9602-00C04F8EE628}, Major:5, Minor: 0
'Name: LEDMETERLib, Description: LEDMeter ActiveX Control module, FullPath: C:\Program Files\ahead\Nero\WaveEditor\LEDMeter.ocx, GUID: {7F0DC2FA-DACB-4A76-B3C3-86A36AB1228A}, Major:1, Minor: 0

'B) Addition Tools on UserForm1

'Frame1
'Frame1\Image1, Label1, Label2
'TextBox1
'Frame2
'Frame2\Label3, Label4
'CommandButton1, CommandButton2

Option Explicit
Dim i As Single, ii As Single
Dim Güç(27) As Double, Seviye As Double, Tekrar As Double
Dim Nesne(27) As Control
'Private WithEvents Seslendirme As SpVoice 'After FormAç Macro, this line will activate
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] LEDMeter ActiveX Control Module"
'Set Seslendirme = New SpVoice 'After FormAç Macro, this line will activate
Call EkranDüzenle
Call Metin

End Sub
Private Sub CommandButton1_Click() 'To Speech

On Error Resume Next
If CommandButton2.Enabled = True Then

CommandButton2.Enabled = True
Seslendirme.Speak TextBox1.Text, SVSFlagsAsync

Else

CommandButton2.Enabled = True
Seslendirme.Resume

End If

End Sub
Private Sub CommandButton2_Click() 'To Pause

On Error Resume Next
CommandButton2.Enabled = False
Seslendirme.Pause

End Sub
Private Sub Seslendirme_Word(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal CharacterPosition As Long, ByVal Length As Long)

On Error Resume Next
With TextBox1

.SetFocus
.SelStart = CharacterPosition
.SelLength = Length

End With
If (Seslendirme.Status.PhonemeId * 2) > 100 Then

Güç(14) = 100

Else

Güç(14) = (Seslendirme.Status.PhonemeId * 2)

End If
DoEvents
Güç(13) = Application.WorksheetFunction.GeoMean(Güç(14), Güç(14)): Güç(15) = Güç(13)
Güç(12) = Application.WorksheetFunction.GeoMean(Güç(13), Güç(13) * 12 * 1 / 13): Güç(16) = Güç(12)
Güç(11) = Application.WorksheetFunction.GeoMean(Güç(12), Güç(12) * 11 * 1 / 13): Güç(17) = Güç(11)
Güç(10) = Application.WorksheetFunction.GeoMean(Güç(11), Güç(11) * 10 * 1 / 13): Güç(18) = Güç(10)
Güç(9) = Application.WorksheetFunction.GeoMean(Güç(10), Güç(10) * 9 * 1 / 13): Güç(19) = Güç(9)
Güç(8) = Application.WorksheetFunction.GeoMean(Güç(9), Güç(9) * 8 * 1 / 13): Güç(20) = Güç(8)
Güç(7) = Application.WorksheetFunction.GeoMean(Güç(8), Güç(8) * 7 * 1 / 13): Güç(21) = Güç(7)
Güç(6) = Application.WorksheetFunction.GeoMean(Güç(7), Güç(7) * 6 * 1 / 13): Güç(22) = Güç(6)
Güç(5) = Application.WorksheetFunction.GeoMean(Güç(6), Güç(6) * 5 * 1 / 13): Güç(23) = Güç(5)
Güç(4) = Application.WorksheetFunction.GeoMean(Güç(5), Güç(5) * 4 * 1 / 13): Güç(24) = Güç(4)
Güç(3) = Application.WorksheetFunction.GeoMean(Güç(4), Güç(4) * 3 * 1 / 13): Güç(25) = Güç(3)
Güç(2) = Application.WorksheetFunction.GeoMean(Güç(3), Güç(3) * 2 * 1 / 13): Güç(26) = Güç(2)
Güç(1) = Application.WorksheetFunction.GeoMean(Güç(2), Güç(2) * 1 * 1 / 13): Güç(27) = Güç(1)
Tekrar = 6
If Tekrar > 0 Then

For i = 1 To Tekrar

For ii = 1 To 27

Seviye = VBA.Round(Güç(ii), 0) * i / Tekrar
With Nesne(ii)

.Reset
.SetLevel Seviye
.RedZone = Seviye - 1
.YellowZone = Seviye - 20
DoEvents

End With

Next ii

Next i
With Label3

.Left = ((324 - 12) * (CharacterPosition / TextBox1.TextLength))
.Width = 12

End With
With Label4

.Width = ((324 - 12) * (CharacterPosition / TextBox1.TextLength))

End With
DoEvents

Else

With Label3

.Left = 0

End With
With Label4

.Width = 0

End With
DoEvents

End If

End Sub
Sub EkranDüzenle()

On Error Resume Next
With Me

.Height = 332
.Width = 388
.BackColor = vbWhite
With Frame1

.Caption = ""
.Left = -1
.Top = -1
.Height = 30
.Width = Me.Width + 12
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\Blogspot\ZarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeStretch
.SpecialEffect = fmSpecialEffectFlat
.BackColor = vbWhite
With Image1

.Left = 1.5
.Top = 1.5
.Height = 24
.Width = 24
.BorderColor = vbBlue
.BackStyle = fmBackStyleTransparent
.Picture = LoadPicture("D:\Mustafa ULUSARAÇ\Blogspot\Örnekİkonlar\PBİD.ico")
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip

End With
With Label1

.Left = 1.5 + 24 + 3
.Top = 1.5
.Caption = "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue

End With
With Label2

.Left = 1.5 + 24 + 3
.Top = 13.5
.Caption = "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.SpecialEffect = fmSpecialEffectFlat
.BorderStyle = fmBorderStyleNone
.Height = 12
.Width = 180
.Font.Bold = True
.ForeColor = vbBlue

End With

End With
With TextBox1

.Left = 6
.Top = 36
.Height = 201
.Width = 372
.ForeColor = &H4000&
.BackColor = &H80000018
.SpecialEffect = fmSpecialEffectEtched
.EnterKeyBehavior = True
.Enabled = True
.Locked = True
.MultiLine = True
.ScrollBars = fmScrollBarsVertical

End With
With Frame2

.Caption = ""
.Left = 6
.Top = 240
.Height = 61
.Width = 324
.SpecialEffect = fmSpecialEffectEtched
.ScrollBars = fmScrollBarsNone
.BackColor = vbBlack
For i = 1 To 27

Set Nesne(i) = .Controls.Add("LEDMETER.LEDMeterCtrl.1")
With Nesne(i)

.Left = (i - 1) * 12
.Top = 0
.Height = 50
.Width = 12
.Reset
.RedZone = .YellowZone - 1
.YellowZone = 60

End With

Next i
With Label3

.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 0
.Top = 50
.Height = 8
.Width = 0 '12
.BackColor = vbWhite
.BorderColor = &HC000&
.BorderStyle = fmBorderStyleSingle

End With
With Label4

.Caption = ""
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 0
.Top = 50
.Height = 8
.Width = 0 '324
.BackColor = &H80FF80

End With

End With
With CommandButton1

.Caption = "Speech"
.Left = 336
.Top = 240
.Height = 30
.Width = 42
.ForeColor = vbGreen
.Font.Bold = True

End With
With CommandButton2

.Caption = "Stop"
.Left = 336
.Top = 276
.Height = 24
.Width = 42
.ForeColor = vbRed
.Font.Bold = True

End With

End With

End Sub
Sub Metin()

On Error Resume Next
TextBox1.Text = "Speech is the vocalized form of human communication."
TextBox1.Text = TextBox1.Text & " " & "It is based upon the syntactic combination of lexicals and names that are drawn from very large (usually >10,000 different words) vocabularies."
TextBox1.Text = TextBox1.Text & " " & "Each spoken word is created out of the phonetic combination of a limited set of vowel and consonant speech sound units."
TextBox1.Text = TextBox1.Text & " " & "These vocabularies, the syntax which structures them, and their set of speech sound units, differ creating the existence of many thousands of different types of mutually unintelligible human languages."
TextBox1.Text = TextBox1.Text & " " & "Human speakers (polyglots) are often able to communicate in two or more of them."
TextBox1.Text = TextBox1.Text & " " & "The vocal abilities that enable humans to produce speech also provide humans with the ability to sing."
TextBox1.Text = TextBox1.Text & " " & "A gestural form of human communication exists for the deaf in the form of sign language."
TextBox1.Text = TextBox1.Text & " " & "Speech in some cultures has become the basis of a written language, often one that differs in its vocabulary, syntax and phonetics from its associated spoken one, a situation called diglossia."
TextBox1.Text = TextBox1.Text & " " & "Speech in addition to its use in communication, it is suggested by some psychologists such as Vygotsky is internally used by mental processes to enhance and organize cognition in the form of an interior monologue."
TextBox1.Text = TextBox1.Text & " " & "Speech is researched in terms of the speech production and speech perception of the sounds used in spoken language."
TextBox1.Text = TextBox1.Text & " " & "Other research topics concern speech repetition, the ability to map heard spoken words into the vocalizations needed to recreated that plays a key role in the vocabulary expansion in children and speech errors."
TextBox1.Text = TextBox1.Text & " " & "Several academic disciplines study these including acoustics, psychology, speech pathology, linguistics, cognitive science, communication studies, otolaryngology and computer science."
TextBox1.Text = TextBox1.Text & " " & "Another area of research is how the human brain in its different areas such as the Broca's area and Wernicke's area underlies speech."
TextBox1.Text = TextBox1.Text & " " & "It is controversial how far human speech is unique in that other animals also communicate with vocalizations."
TextBox1.Text = TextBox1.Text & " " & "While none in the wild uses syntax nor compatibly large vocabularies, research upon the nonverbal abilities of language trained apes such as Washoe and Kanzi raises the possibility that they might have these capabilities."
TextBox1.Text = TextBox1.Text & " " & "By Wikipedia, Speech"

End Sub


'Module1

Dim i As Single
Sub FormAç()

On Error Resume Next
With ThisWorkbook.VBProject

With .References

.AddFromGuid "{C866CA3A-32F7-11D2-9602-00C04F8EE628}", 5, 0 'Microsoft Speech Object Library
.AddFromGuid "{7F0DC2FA-DACB-4A76-B3C3-86A36AB1228A}", 1, 0 'LEDMeter ActiveX Control module

End With
With .VBComponents("UserForm1").CodeModule

For i = 1 To .CountOfLines

If .Lines(i, 1) = "'Private WithEvents Seslendirme As SpVoice 'After FormAç Macro, this line will activate" Then ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule.ReplaceLine i, "Private WithEvents Seslendirme As SpVoice"
If .Lines(i, 1) = "'Set Seslendirme = New SpVoice 'After FormAç Macro, this line will activate" Then ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule.ReplaceLine i, "Set Seslendirme = New SpVoice"

Next i

End With

End With
UserForm1.Show

End Sub

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