Excel上的VB小程序

  1   Dim j As Integer
  2   Dim i As Integer
  3   Dim strvoices(30) As String
  4   Dim strbuttons(30) As String
  5   Dim ibuttonid(30) As Integer
  6   Dim igrammer As Integer
  7 
  8 
  9 
 10 Sub Click()
 11 
 12   
 13   j = 16
 14   i = 0
 15   
 16   With Worksheets(4)
 17   igrammer = .Cells(j, 4)
 18   While (.Cells(j, 6) <> "")
 19       If igrammer = .Cells(j, 4) Or .Cells(j, 4) = "" Then
 20           strvoices(i) = .Cells(j, 6)
 21           strbuttons(i) = .Cells(j, 7)
 22           i = i + 1
 23           j = j + 1
 24       Else
 25           
 26             For k = 0 To i - 1
 27                 Select Case strbuttons(k)
 28                 Case .Cells(5, 9)
 29                    ibuttonid(k) = .Cells(5, 10)
 30                 Case .Cells(6, 9)
 31                    ibuttonid(k) = .Cells(6, 10)
 32                 Case .Cells(7, 9)
 33                    ibuttonid(k) = .Cells(7, 10)
 34                 Case .Cells(8, 9)
 35                    ibuttonid(k) = .Cells(8, 10)
 36                 Case .Cells(9, 9)
 37                    ibuttonid(k) = .Cells(9, 10)
 38                 Case .Cells(10, 9)
 39                    ibuttonid(k) = .Cells(10, 10)
 40                 Case .Cells(11, 9)
 41                    ibuttonid(k) = .Cells(11, 10)
 42                 Case .Cells(12, 9)
 43                    ibuttonid(k) = .Cells(12, 10)
 44                 Case .Cells(13, 9)
 45                    ibuttonid(k) = .Cells(13, 10)
 46                 Case .Cells(14, 9)
 47                    ibuttonid(k) = .Cells(14, 10)
 48                 Case .Cells(15, 9)
 49                    ibuttonid(k) = .Cells(15, 10)
 50                 Case .Cells(16, 9)
 51                    ibuttonid(k) = .Cells(16, 10)
 52                 Case .Cells(17, 9)
 53                    ibuttonid(k) = .Cells(17, 10)
 54                 Case .Cells(18, 9)
 55                    ibuttonid(k) = .Cells(18, 10)
 56                 Case .Cells(19, 9)
 57                    ibuttonid(k) = .Cells(19, 10)
 58                 Case .Cells(20, 9)
 59                    ibuttonid(k) = .Cells(20, 10)
 60                 Case .Cells(21, 9)
 61                    ibuttonid(k) = .Cells(21, 10)
 62                 Case Else
 63                    ibuttonid(k) = 0
 64                 End Select
 65             Next k
 66 
 67             creatfile
 68             i = 0
 69             igrammer = .Cells(j, 4)
 70       End If
 71   
 72   
 73   Wend
 74   creatfile
 75   
 76   End With
 77 
 78 End Sub
 79 
 80 Function creatfile()
 81     
 82     If Dir(ThisWorkbook.Path + "\input_grxml", vbDirectory) = "" Then
 83         MkDir ThisWorkbook.Path + "\input_grxml"
 84     End If
 85     Open ThisWorkbook.Path + "\input_grxml\" + CStr(igrammer) + ".grxml" For Output As i
 86     Print #i, "<?xml version=" + Chr(34) + "1.0" + Chr(34) + " encoding=" + Chr(34) + "shift_jis" + Chr(34) + "?>"
 87     Print #i, "<grammar xmlns=" + Chr(34) + "http://www.w3.org/2001/06/grammar" + Chr(34)
 88     Print #i, Chr(9) + "version=" + Chr(34) + "1.0" + Chr(34) + " mode=" + Chr(34) + "voice" + Chr(34) + " xml:lang=" + Chr(34) + "ja" + Chr(34) + " tag-format=" + Chr(34) + "semantics/1.0" + Chr(34) + " root=" + Chr(34) + "main" + Chr(34) + ">" + Chr(13)
 89     Print #i, Chr(9) + "<meta name=" + Chr(34) + "Creator" + Chr(34) + " content=" + Chr(34) + "animo" + Chr(34) + " />"
 90     Print #i, Chr(9) + "<meta name=" + Chr(34) + "Date" + Chr(34) + " content=" + Chr(34) + "2014/10/15" + Chr(34) + " />"
 91     Print #i, Chr(9) + "<meta name=" + Chr(34) + "Subject" + Chr(34) + " content=" + Chr(34) + "3" + Chr(34) + " />"
 92     Print #i, Chr(9) + "<meta name=" + Chr(34) + "Description" + Chr(34) + " content=" + Chr(34) + "3" + Chr(34) + " />"
 93     Print #i, Chr(9) + "<rule id=" + Chr(34) + "main" + Chr(34) + ">"
 94     Print #i, Chr(9) + Chr(9) + "<tag>state=" + Chr(34) + Chr(34) + "</tag>"
 95     Print #i, Chr(9) + Chr(9) + "<item>"
 96     Print #i, Chr(9) + Chr(9) + Chr(9) + "<ruleref uri=" + Chr(34) + "#s" + CStr(igrammer) + Chr(34) + "/>"
 97     Print #i, Chr(9) + Chr(9) + Chr(9) + "<tag>state=state + $$</tag>"
 98     Print #i, Chr(9) + Chr(9) + "</item>"
 99     Print #i, Chr(9) + "</rule>" + Chr(13) + Chr(13)
100     Print #i, Chr(9) + "<rule id=" + Chr(34) + "s" + CStr(igrammer) + Chr(34) + ">"
101     Print #i, Chr(9) + Chr(9) + "<one-of>"
102             
103     For k = 0 To i - 1
104     Print #i, Chr(9) + Chr(9) + Chr(9) + "<item><tag>" + Chr(34) + CStr(ibuttonid(k)) + Chr(34) + "</tag>" + strvoices(k) + "</item>"
105     Next k
106             
107     Print #i, Chr(9) + Chr(9) + "</one-of>"
108     Print #i, Chr(9) + "</rule>" + Chr(13) + Chr(13)
109     Print #i, "</grammar>"
110            
111     Close
112     
113 End Function

 

转载于:https://www.cnblogs.com/mrright/p/4102914.html