Set objSpk = Createobject("SAPI.SpVoice")
objSpk.speak("北京欢迎你")
复制代码

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 Function
复制代码