[技术讨论] 文本语音朗读VBS脚本

牛虻

文本语音朗读脚本

Set objSpk = Createobject("SAPI.SpVoice")
objSpk.speak("北京欢迎你")COPY

牛虻

能不能发出 do ruai mi fa sao la xi的声音
这样也许就可以唱歌了

523066680

结果就是哆啦咪发骚拉稀，如果你要控制蜂鸣器的音调还比较有的搞。

牛虻

我试了，结果不对。你说控制蜂鸣器的音调，怎么弄？

yu2n

Beep 周杰伦-回到过去

Option Explicit
 
' 获取 Excel 对象
Dim oExcel, oBook
Set oExcel = Excel_Init
Set oBook = oExcel.ActiveWorkbook
 
'提示非台式机用户选择是否继续
If LCase(ChassisType()) <> LCase("Desktop") Then
  If CreateObject("WScript.Shell").Popup(_
    "你的电脑不是台式机(桌面计算机)，将会导致扬声器发出较大的噪声，请注意调小音量！" & VbCrLf & VbCrLf & _
    "退出程序，请按“确定”，否则请按“取消”。(7秒后自动取消)", 7, "警告", 48+4096+1) = 1 Then
    WScript.Quit
  End If
End If
 
'内存报警实例
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放BIOS内存报警声……　　　" , 2, "提示", 64+4096+0
Beep 880, 600: Sleep 200  '內存
Beep 880, 200: Sleep 200
Beep 880, 200: Sleep 200
 
'//do~si 节奏数据来自VBS吧
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放so~si音阶……　　　　　" , 2, "提示", 64+4096+0
playsnd 440, 100
playsnd 494, 100
playsnd 554, 100
playsnd 622, 100
playsnd 698, 100
playsnd 784, 100
playsnd 880, 100 
 
'//周杰伦的回到过去 节奏数据来自VBS吧
CreateObject("WScript.Shell").Popup "稍等2秒，即将播放《周杰伦-回到过去》……" , 2, "提示", 64+4096+0
playsnd 587, 100: playsnd 784, 100: playsnd 880, 100: playsnd 988, 100:: playsnd 988, 200: playsnd 0, 100
playsnd 988, 100: playsnd 880, 100: playsnd 988, 100: playsnd 1047, 200: playsnd 988, 100: playsnd 988, 100
playsnd 880, 100: playsnd 100, 150: playsnd 880, 100: playsnd 784, 100:: playsnd 988, 100: playsnd 0, (5)
playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 880, 100
playsnd 784, 100: playsnd 740, 100: playsnd 784, 200: playsnd 100, 200:: playsnd 784, 100: playsnd 880, 100
playsnd 784, 100: playsnd 988, 100: playsnd 0, (5)::: playsnd 988, 100:: playsnd 0, (5)::: playsnd 988, 100
playsnd 0, (5)::: playsnd 988, 100: playsnd 100, 100: playsnd 587, 100:: playsnd 784, 100: playsnd 1175, 100
playsnd 0, (5)::: playsnd 1175, 99: playsnd 988, 100: playsnd 0, (5):::: playsnd 988, 100: playsnd 0, (5)
playsnd 987, 100: playsnd 100, 100: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 100: playsnd 880, 200
playsnd 784, 100: playsnd 0, (5)::: playsnd 784, 100: playsnd 0, (5):::: playsnd 784, 50:: playsnd 659, (50)
playsnd 784, 100: playsnd 659, 100: playsnd 784, 100: playsnd 880, 100:: playsnd 100, 100: playsnd 587, 110
playsnd 784, 120: playsnd 880, 130: playsnd 740, 140: playsnd 784, 200:: playsnd 1, 1::::: playsnd 1, 1 
 
 
' 关闭 Excel 
Excel_Quit
WScript.Quit
 
 
Function Excel_Init()
  Dim WshShell
  Dim oExcel, oBook, oModule
  Dim strRegKey, strCode
  Set oExcel = CreateObject("Excel.Application")
  set WshShell = CreateObject("WScript.Shell")
  strRegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
  strRegKey = Replace(strRegKey, "$", oExcel.Version)
  WshShell.RegWrite strRegKey, 1, "REG_DWORD"
  Set oBook = oExcel.Workbooks.Add
  Set oModule = obook.VBProject.VBComponents.Add(1)
  strCode = _
  "Declare Sub Beep Lib ""kernel32"" (ByVal fre As Long, ByVal ms As Long)" & vbCr & _
  "Declare Sub Sleep Lib ""kernel32"" (ByVal ms As Long)"
  oModule.CodeModule.AddFromString strCode
  Set Excel_Init = oExcel
End Function
 
Function playsnd(ByVal x, ByVal y)
  Beep x, y * 3
End Function
 
Sub Beep(fre,ms)
  oExcel.Run "Beep",fre,ms
End Sub
 
Sub Sleep(ms)
  oExcel.Run "Sleep",ms
End Sub
 
Function Excel_Quit()
  oExcel.DisplayAlerts = False
  'oBook.Close
  oExcel.ActiveWorkbook.Close
  oExcel.Quit
End Function
 
 
'判断计算机类型，只允许台式机发声(笔记本会使用扬声器发声，声音太刺耳)
Function ChassisType()
  Dim strComputer, objWMIService, colChassis, objChassis, strChassisType
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:" _
              & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
  Set colChassis = objWMIService.ExecQuery _
              ("Select * from Win32_SystemEnclosure")
  For Each objChassis in colChassis
    For Each strChassisType in objChassis.ChassisTypes
      Select Case strChassisType
        Case 1
          ChassisType = "Other"
        Case 2
          ChassisType = "Unknown"
        Case 3
          ChassisType = "Desktop"
        Case 4
          ChassisType = "Low Profile Desktop"
        Case 5
          ChassisType = "Pizza Box"
        Case 6
          ChassisType = "Mini Tower"
        Case 7
          ChassisType = "Tower"
        Case 8
          ChassisType = "Portable"
        Case 9
          ChassisType = "Laptop"
        Case 10
          ChassisType = "Notebook"
        Case 11
          ChassisType = "Handheld"
        Case 12
          ChassisType = "Docking Station"
        Case 13
          ChassisType = "All-in-One"
        Case 14
          ChassisType = "Sub-Notebook"
        Case 15
          ChassisType = "Space Saving"
        Case 16
          ChassisType = "Lunch Box"
        Case 17
          ChassisType = "Main System Chassis"
        Case 18
          ChassisType = "Expansion Chassis"
        Case 19
          ChassisType = "Sub-Chassis"
        Case 20
          ChassisType = "Bus Expansion Chassis"
        Case 21
          ChassisType = "Peripheral Chassis"
        Case 22
          ChassisType = "Storage Chassis"
        Case 23
          ChassisType = "Rack Mount Chassis"
        Case 24
          ChassisType = "Sealed-Case PC"
        Case Else
          ChassisType = "Unknown"
      End Select
    Next
  Next
End FunctionCOPY

牛虻

我突然又想到是不是可以写个类似学舌猫一样的脚本啊

牛虻

回复 5# yu2n


    不对啊！我运行报错 ！

yu2n

回复 7# 牛虻
直接点代码下面那个【复制代码】按钮试试……

牛虻

回复 8# yu2n


    我就是这样复制的
我在第二行加上on error resume next后有弹窗，没声音

牛虻

问一下playsnd  是什么？

牛虻

回复 8# yu2n


   这一行出错 Set oModule = obook.VBProject.VBComponents.Add(1)

yu2n

回复 11# 牛虻
具体原因不清楚，猜测可能与杀毒软件有关。

Linuxer

回复 6# 牛虻


    读出声音简单，但是要按你的想法，汤姆猫那种，，，是(相当)^n的有难度。。。。不建议研究。。