能否幫我把vba簡體文字代碼翻成繁體

good8195

因為我的excel是繁體版本,下載後所有字都變亂碼,連拉上去網上翻譯的機會都沒有
怕下載後上傳也是一樣情況,恐怕需要大俠們幫幫我下載並上傳給我

想要這位老師的這篇文章做學習

将Excel数据写入Word文档
http://club.excelhome.net/thread-477904-1-1.html


還有這篇,這就比較麻煩了,我已留言把我問題給他了
但因為今天放假想學習更高深的東西,還是發文請助
還有各路高手的插件,工具箱我也是一樣情況,請問有解嗎?

[2015！来吧！一键收集代码、一键写代码、一键封装代码]VBA代码盒子5.0---梁小铭
http://club.excelhome.net/thread-1179608-1-1.html

Vicel

请参考

good8195

Vicel 发表于 2015-5-13 13:45
请参考

老師您好,謝謝您又來幫助我了
不過這次問題不是頁面的簡轉繁
是vba裏頭(難過)
附圖給你看一下好了


如果暫時無法解決的話
我希望有人能幫我複上面製檔案的vba代碼給我
我再去修改研究

Vicel

good8195 发表于 2015-5-13 14:28
老師您好,謝謝您又來幫助我了
不過這次問題不是頁面的簡轉繁
是vba裏頭(難過)

你给的两个链接里的附件不算少，不容易帮忙呀
你可以试上传一个压缩包上来，我帮你看看能否转换了传回给你

good8195

Vicel 发表于 2015-5-13 15:16
你给的两个链接里的附件不算少，不容易帮忙呀
你可以试上传一个压缩包上来，我帮你看看能否转换了传回给 ...

不要造成你的負擔,三個檔案就好了
第二個連結是工具箱,應該不是隨便複製就能
Desktop.rar (70.98 KB, 下载次数: 10)

2015-5-13 15:19 上传

点击文件名下载附件

Vicel

good8195 发表于 2015-5-13 15:20
不要造成你的負擔,三個檔案就好了
第二個連結是工具箱,應該不是隨便複製就能

看看。有一个档案好象是重复的，查杀到有异常，只把两个档案的转成繁体了
test.rar (26.12 KB, 下载次数: 12)

2015-5-13 16:05 上传

点击文件名下载附件

good8195

Vicel 发表于 2015-5-13 16:06
看看。有一个档案好象是重复的，查杀到有异常，只把两个档案的转成繁体了

沒有重複,是有兩個版本,那個最重要的是excel vba轉成繁體的
但是剛剛看都沒有(掩面)

Vicel

good8195 发表于 2015-5-13 16:13
沒有重複,是有兩個版本,那個最重要的是excel vba轉成繁體的
但是剛剛看都沒有(掩面)

漏了一个，补上
工程付款申請(未使用迴圈).rar (14.91 KB, 下载次数: 7)

2015-5-13 16:39 上传

点击文件名下载附件

good8195

Vicel 发表于 2015-5-13 16:39
漏了一个，补上

還是一樣
老師你直接把這三個excel的vba代碼貼上來好了
我在自己慢慢改,要不然代碼在excel裡面我的都會自己變亂碼

ㄧ

Vicel

good8195 发表于 2015-5-13 17:34
還是一樣
老師你直接把這三個excel的vba代碼貼上來好了
我在自己慢慢改,要不然代碼在excel裡面我的都會 ...

1. 
   
2. Private Sub Worksheet_Activate()
   
3. Sheet1.[f1] = Sheet1.[f10]
   
4. Sheet1.[g1] = Sheet1.[g10]
   
5. Sheet1.[f2] = Sheet1.[f11]
   
6. Sheet1.[g2] = Sheet1.[g11]
   
7.    
   
8. End Sub
   
9. 
   
10. Private Sub 生成Word檔_Click()
    
11.    Dim Word對象 As New Word.Application, 當前路徑, 導出檔案名, 導出路徑檔案名, 資料名
    
12.    Dim i, j
    
13.    Dim Str1, Str2
    
14.    當前路徑 = ThisWorkbook.Path
    
15.    數據表名 = "付款申請表"
    
16.    最後行號 = Sheets(數據表名).Range("B65536").End(xlUp).Row
    
17.    判斷 = 0
    
18.    For i = 3 To 最後行號
    
19.       導出檔案名 = "工程付款申請單"
    
20.       FileCopy 當前路徑 & "\工程付款申請單(範本).doc", 當前路徑 & "" & 導出檔案名 & "(" & Sheets(數據表名).Range("B" & i) & ").doc"
    
21.       導出路徑檔案名 = 當前路徑 & "" & 導出檔案名 & "(" & Sheets(數據表名).Range("B" & i) & ").doc"
    
22.       With Word對象
    
23.          .Documents.Open 導出路徑檔案名
    
24.          .Visible = False
    
25.          '******************為便於理解和移植代碼，這裏就不採用迴圈的方法了！***************************
    
26.          '填寫文字資料
    
27.          Str1 = "數據1"
    
28.          Str2 = Sheets(數據表名).Cells(i, 2)
    
29.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
30.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
31.             .Selection.Text = Str2 '替換字串
    
32.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
33.          End If
    
34.         
    
35.          Str1 = "數據2"
    
36.          Str2 = Sheets(數據表名).Cells(i, 3)
    
37.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
38.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
39.             .Selection.Text = Str2 '替換字串
    
40.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
41.          End If
    
42.         
    
43.          Str1 = "數據3"
    
44.          Str2 = Sheets(數據表名).Cells(i, 4)
    
45.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
46.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
47.             .Selection.Text = Str2 '替換字串
    
48.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
49.          End If
    
50.         
    
51.          Str1 = "數據4"
    
52.          Str2 = Sheets(數據表名).Cells(i, 5)
    
53.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
54.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
55.             .Selection.Text = Str2 '替換字串
    
56.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
57.          End If
    
58.         
    
59.          Str1 = "數據4"
    
60.          Str2 = Sheets(數據表名).Cells(i, 5)
    
61.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
62.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
63.             .Selection.Text = Str2 '替換字串
    
64.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
65.          End If
    
66.         
    
67.          Str1 = "數據5"
    
68.          Str2 = Sheets(數據表名).Cells(i, 6)
    
69.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
70.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
71.             .Selection.Text = Str2 '替換字串
    
72.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
73.          End If
    
74.         
    
75.          Str1 = "數據6"
    
76.          Str2 = Sheets(數據表名).Cells(i, 7)
    
77.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
78.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
79.             .Selection.Text = Str2 '替換字串
    
80.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
81.          End If
    
82.         
    
83.          Str1 = "數據4"
    
84.          Str2 = Sheets(數據表名).Cells(i, 5)
    
85.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
86.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
87.             .Selection.Text = Str2 '替換字串
    
88.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
89.          End If
    
90.         
    
91.          Str1 = "數據7"
    
92.          Str2 = Sheets(數據表名).Cells(i, 8)
    
93.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
94.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
95.             .Selection.Text = Str2 '替換字串
    
96.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
97.          End If
    
98.         
    
99.          Str1 = "數據8"
    
100.          Str2 = Sheets(數據表名).Cells(i, 9)
     
101.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
102.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
103.             .Selection.Text = Str2 '替換字串
     
104.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
105.          End If
     
106.         
     
107.          Str1 = "數據9"
     
108.          Str2 = Sheets(數據表名).Cells(i, 10)
     
109.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
110.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
111.             .Selection.Text = Str2 '替換字串
     
112.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
113.          End If
     
114.          Str1 = "數據10"
     
115.          Str2 = Sheets(數據表名).Cells(i, 11)
     
116.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
117.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
118.             .Selection.Text = Str2 '替換字串
     
119.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
120.          End If
     
121.         
     
122.          Str1 = "數據4"
     
123.          Str2 = Sheets(數據表名).Cells(i, 5)
     
124.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
125.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
126.             .Selection.Text = Str2 '替換字串
     
127.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
128.          End If
     
129.         
     
130.          Str1 = "數據11"
     
131.          Str2 = Sheets(數據表名).Cells(i, 12)
     
132.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
133.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
134.             .Selection.Text = Str2 '替換字串
     
135.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
136.          End If
     
137.         
     
138.          Str1 = "數據12"
     
139.          Str2 = Sheets(數據表名).Cells(i, 13)
     
140.          .Selection.HomeKey Unit:=wdStory '游標置於文件首
     
141.          If .Selection.Find.Execute(Str1) Then '查找到指定字串
     
142.             .Selection.Text = Str2 '替換字串
     
143.             .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
     
144.          End If
     
145. 
     
146.         '填寫表格資料
     
147.         .ActiveDocument.Tables(1).Cell(3, 2).Range = Sheets(數據表名).Cells(i, 14)
     
148.         .ActiveDocument.Tables(1).Cell(3, 3).Range = Sheets(數據表名).Cells(i, 15)
     
149.         .ActiveDocument.Tables(1).Cell(3, 4).Range = Sheets(數據表名).Cells(i, 16)
     
150.         .ActiveDocument.Tables(1).Cell(3, 5).Range = Sheets(數據表名).Cells(i, 17)
     
151.         
     
152.         .ActiveDocument.Tables(1).Cell(4, 2).Range = Sheets(數據表名).Cells(i, 18)
     
153.         .ActiveDocument.Tables(1).Cell(4, 3).Range = Sheets(數據表名).Cells(i, 19)
     
154.         .ActiveDocument.Tables(1).Cell(4, 4).Range = Sheets(數據表名).Cells(i, 20)
     
155.         .ActiveDocument.Tables(1).Cell(4, 5).Range = Sheets(數據表名).Cells(i, 21)
     
156.         
     
157.         .ActiveDocument.Tables(1).Cell(5, 2).Range = Sheets(數據表名).Cells(i, 22)
     
158.         .ActiveDocument.Tables(1).Cell(5, 3).Range = Sheets(數據表名).Cells(i, 23)
     
159.         .ActiveDocument.Tables(1).Cell(5, 4).Range = Sheets(數據表名).Cells(i, 24)
     
160.         .ActiveDocument.Tables(1).Cell(5, 5).Range = Sheets(數據表名).Cells(i, 25)
     
161.         
     
162.         .ActiveDocument.Tables(1).Cell(6, 2).Range = Sheets(數據表名).Cells(i, 26)
     
163.         .ActiveDocument.Tables(1).Cell(6, 3).Range = Sheets(數據表名).Cells(i, 27)
     
164.         .ActiveDocument.Tables(1).Cell(6, 4).Range = Sheets(數據表名).Cells(i, 28)
     
165.         .ActiveDocument.Tables(1).Cell(6, 5).Range = Sheets(數據表名).Cells(i, 29)
     
166.       
     
167.         .ActiveDocument.Tables(1).Cell(9, 2).Range = Sheets(數據表名).Cells(i, 30)
     
168.         .ActiveDocument.Tables(1).Cell(9, 3).Range = Sheets(數據表名).Cells(i, 31)
     
169.         .ActiveDocument.Tables(1).Cell(9, 4).Range = Sheets(數據表名).Cells(i, 32)
     
170.         .ActiveDocument.Tables(1).Cell(9, 5).Range = Sheets(數據表名).Cells(i, 33)
     
171.         
     
172.         .ActiveDocument.Tables(1).Cell(10, 2).Range = Sheets(數據表名).Cells(i, 34)
     
173.         .ActiveDocument.Tables(1).Cell(10, 3).Range = Sheets(數據表名).Cells(i, 35)
     
174.         .ActiveDocument.Tables(1).Cell(10, 4).Range = Sheets(數據表名).Cells(i, 36)
     
175.         .ActiveDocument.Tables(1).Cell(10, 5).Range = Sheets(數據表名).Cells(i, 37)
     
176.         
     
177.         .ActiveDocument.Tables(1).Cell(11, 2).Range = Sheets(數據表名).Cells(i, 38)
     
178.         .ActiveDocument.Tables(1).Cell(11, 3).Range = Sheets(數據表名).Cells(i, 39)
     
179.         .ActiveDocument.Tables(1).Cell(11, 4).Range = Sheets(數據表名).Cells(i, 40)
     
180.         .ActiveDocument.Tables(1).Cell(11, 5).Range = Sheets(數據表名).Cells(i, 41)
     
181.         
     
182.         .ActiveDocument.Tables(1).Cell(12, 2).Range = Sheets(數據表名).Cells(i, 42)
     
183.         .ActiveDocument.Tables(1).Cell(12, 3).Range = Sheets(數據表名).Cells(i, 43)
     
184.         .ActiveDocument.Tables(1).Cell(12, 4).Range = Sheets(數據表名).Cells(i, 44)
     
185.         .ActiveDocument.Tables(1).Cell(12, 5).Range = Sheets(數據表名).Cells(i, 45)
     
186.         
     
187.         .ActiveDocument.Tables(1).Cell(13, 2).Range = Sheets(數據表名).Cells(i, 46)
     
188.         .ActiveDocument.Tables(1).Cell(13, 3).Range = Sheets(數據表名).Cells(i, 47)
     
189.         .ActiveDocument.Tables(1).Cell(13, 4).Range = Sheets(數據表名).Cells(i, 48)
     
190.         .ActiveDocument.Tables(1).Cell(13, 5).Range = Sheets(數據表名).Cells(i, 49)
     
191.       End With
     
192.       Word對象.Documents.Save
     
193.       Word對象.Quit
     
194.       Set Word對象 = Nothing
     
195.    Next i
     
196.    If 判斷 = 0 Then
     
197.       j = MsgBox("已輸出到 Word 檔！", 0 + 48 + 256 + 0, "提示：")
     
198.    End If
     
199. End Sub
     

复制代码

1. Function dxje(q)
   
2. ybb = Round(q * 100) '將輸入的數值擴大100倍，進行四捨五入
   
3. y = Int(ybb / 100) '截取出整數部分
   
4. j = Int(ybb / 10) - y * 10 '截取出十分位
   
5. f = ybb - y * 100 - j * 10 '截取出百分位
   
6. zy = Application.WorksheetFunction.Text(y, "[dbnum2]") '將整數部分轉為中文大寫
   
7. zj = Application.WorksheetFunction.Text(j, "[dbnum2]") '將十分位轉為中文大寫
   
8. zf = Application.WorksheetFunction.Text(f, "[dbnum2]") '將百分位轉為中文大寫
   
9. dxje = zy & "元" & "整"
   
10. d1 = zy & "元"
    
11. If f <> 0 And j <> 0 Then
    
12. dxje = d1 & zj & "角" & zf & "分"
    
13. If y = 0 Then
    
14. dxje = zj & "角" & zf & "分"
    
15. End If
    
16. End If
    
17. If f = 0 And j <> 0 Then
    
18. dxje = d1 & zj & "角" & "整"
    
19. If y = 0 Then
    
20. dxje = zj & "角" & "整"
    
21. End If
    
22. End If
    
23. If f <> 0 And j = 0 Then
    
24. dxje = d1 & zj & zf & "分"
    
25. If y = 0 Then
    
26. dxje = zf & "分"
    
27. End If
    
28. End If
    
29. If q = "" Then
    
30. dxje = 0 '如沒有輸入任何數值為0
    
31. End If
    
32. End Function

复制代码

1. Private Sub CommandButton輸出通知到Word檔_Click()
   
2.    Dim Word對象 As New Word.Application, 當前路徑, 導出檔案名, 導出路徑檔案名, i, j
   
3.    Dim Str1, Str2
   
4.    當前路徑 = ThisWorkbook.Path
   
5.    最後行號 = Sheets("數據").Range("B65536").End(xlUp).Row
   
6.    判斷 = 0
   
7.    For i = 2 To 最後行號
   
8.       導出檔案名 = "授課通知"
   
9.       FileCopy 當前路徑 & "\授課通知(範本).doc", 當前路徑 & "" & 導出檔案名 & "(" & Sheets("數據").Range("B" & i) & ").doc"
   
10.       導出路徑檔案名 = 當前路徑 & "" & 導出檔案名 & "(" & Sheets("數據").Range("B" & i) & ").doc"
    
11.       With Word對象
    
12.         .Documents.Open 導出路徑檔案名
    
13.         .Visible = False
    
14.         For j = 1 To 5 '填寫文字資料
    
15.            Str1 = "數據" & Format(j, "000")
    
16.            Str2 = Sheets("數據").Cells(i, j + 1)
    
17.            .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
18.            If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
19.               .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
20.               .Selection.Text = Str2 '替換字串
    
21.            End If
    
22.         Next j
    
23.         For j = 1 To 3 '填寫表格資料
    
24.            .ActiveDocument.Tables(1).Cell(2, j).Range = Sheets("數據").Cells(i, j + 6)
    
25.            .ActiveDocument.Tables(1).Cell(4, j).Range = Sheets("數據").Cells(i, j + 9)
    
26.         Next j
    
27.         .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader '設置位置在頁眉
    
28.         Str1 = "數據006"
    
29.         Str2 = Sheets("數據2").Cells(2, 2)
    
30.         .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
31.         If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
32.            .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
33.            .Selection.Text = Str2 '替換字串
    
34.         End If
    
35.         .ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter '設置位置在頁腳
    
36.         Str1 = "數據007"
    
37.         Str2 = Sheets("數據2").Cells(2, 1)
    
38.         .Selection.HomeKey Unit:=wdStory '游標置於文件首
    
39.         If .Selection.Find.Execute(Str1) Then '查找到指定字串
    
40.            .Selection.Font.Color = wdColorAutomatic '字元為自動顏色
    
41.            .Selection.Text = Str2 '替換字串
    
42.         End If
    
43.       End With
    
44.       Word對象.Documents.Save
    
45.       Word對象.Quit
    
46.       Set Word對象 = Nothing
    
47.    Next i
    
48.    If 判斷 = 0 Then
    
49.       i = MsgBox("已輸出到 Word 檔！", 0 + 48 + 256 + 0, "提示：")
    
50.    End If
    
51. End Sub

复制代码