Board logo

標題: [發問] 請問如何讓出來的文字不同顏色及轉簡體字或者繁體字 [打印本頁]
作者: 198188    時間: 2014-7-3 10:58     標題: 請問如何讓出來的文字不同顏色及轉簡體字或者繁體字

Worksheets(customer).Cells(cnt, 10).Value =  "發票金額：USD" & Worksheets("Oracle").Cells(I, 18).Value & "          箱數:" & Worksheets("Oracle").Cells(I, 41).Value & "               櫃號:" & Split(Worksheets("Oracle").Cells(I, 42).Value, "/")(0) & "               目的港：" & Worksheets("Oracle").Cells(I, 26).Value ”

請問：
如上的VBA, 如果想出來的效果某些字有顏色，可以嗎？
比如 ：
"發票金額：USD" & Worksheets("Oracle").Cells(I, 18).Value & "  這段的文字要紅色
"               目的港：" & Worksheets("Oracle").Cells(I, 26).Value ”這段的文字要藍色

還有可否出來後把所有文件轉簡體字或者繁體字？
作者: stillfish00    時間: 2014-7-4 14:01

回復 1# 198188
換色可利用 Range.Characters ; 繁簡轉換我不會
  1. Sub Test()
  2.   Dim s1 As String, s2 As String
  3.   
  4.   s1 = "發票金額：USD" & Worksheets("Oracle").Cells(i, 18).Value
  5.   s2 = "               目的港：" & Worksheets("Oracle").Cells(i, 26).Value
  6.   s = s1 & "          箱數:" & Worksheets("Oracle").Cells(i, 41).Value & "               櫃號:" & Split(Worksheets("Oracle").Cells(i, 42).Value, "/")(0) & s2
  7.   
  8.   With Worksheets(customer).Cells(cnt, 10)
  9.     .Value = s
  10.     .Characters(InStr(s, s1), Len(s1)).Font.Color = vbRed
  11.     .Characters(InStr(s, s2), Len(s2)).Font.Color = vbBlue
  12.   End With
  13. End Sub
複製代碼
作者: c_c_lai    時間: 2014-7-5 09:06

回復 1# 198188
回復 2# stillfish00
套用 stillfish00 大大的程式碼：
  1. Dim wrdApp As Object

  3. Sub Test()
  4.     Dim s1 As String, s2 As String
  5.   
  6.     Set wrdApp = CreateObject("Word.Document")
  7.     Application.ScreenUpdating = False
  8.    
  9.     s1 = "發票金額：USD" & Worksheets("Oracle").Cells(i, 18).Value
  10.     s2 = "               目的港：" & Worksheets("Oracle").Cells(i, 26).Value
  11.     s = s1 & "          箱數:" & Worksheets("Oracle").Cells(i, 41).Value & "               櫃號:" & Split(Worksheets("Oracle").Cells(i, 42).Value, "/")(0) & s2
  12.   
  13.     With Worksheets(customer).Cells(cnt, 10)
  14.         .Value = s
  15.         .Characters(InStr(s, s1), Len(s1)).Font.Color = vbRed
  16.         .Characters(InStr(s, s2), Len(s2)).Font.Color = vbBlue
  17.    
  18.         ' 1 繁轉簡  0 簡轉繁
  19.         .Value = T_S_Cvt(.Value, 1)
  20.     End With
  21.    
  22.     Application.ScreenUpdating = True
  23.     wrdApp.Close False
  24. End Sub

  26. Public Function T_S_Cvt(strData, bytOption) As String
  27.     With wrdApp
  28.         .Content = strData
  29.         ' 調用 Word TCSCConverter 方法來轉換繁簡體
  30.         .Range.TCSCConverter bytOption, True, True
  31.         T_S_Cvt = .Content
  32.     End With
  33. End Function
複製代碼
作者: 198188    時間: 2014-7-7 14:50

  1. Sub SCHPN()
  2.   Dim I As Double
  3.   Dim cnt As Double
  4.   Dim customer As String
  5.   Dim A As String
  6.   Dim LastRec As Integer
  7.   Dim k As Integer
  8.   Dim j As Integer
  9.   Dim l As Integer
  10.   Dim m As Double
  11.   Dim z As Integer
  12.   Dim y As Integer
  13.   Dim e As Integer
  14.   Dim d As Integer
  15.   Dim f As Integer
  16.   Dim FRng As Range
  17.   Dim s1 As String, s2 As String, s3 As String
  18.   Dim wrdApp As Object

  20.   j = Worksheets("Oracle").Range("A" & Worksheets("Oracle").Rows.Count).End(xlUp).Row
  21.   l = Worksheets("Follower").Range("A" & Worksheets("Follower").Rows.Count).End(xlUp).Row
  22.   z = Worksheets("Rule").Range("B" & Worksheets("Rule").Rows.Count).End(xlUp).Row
  23.   y = 39
  24.   Do
  25.    Set wrdApp = CreateObject("Word.Document")

  27.     Application.ScreenUpdating = False
  28.   f = 0
  29.   d = 0
  30.   e = 0
  31.   cnt = 74  

  33.   A = Worksheets("Rule").Cells(y, 2).Value
  34.   customer = A
  35.   Worksheets("SchPN").Copy After:=Worksheets(Worksheets.Count)
  36.   Worksheets(Worksheets.Count).Name = customer
  37.   Worksheets(customer).Range("H5").Value = Date
  38. For I = 2 To j
  39.   If Worksheets("Oracle").Cells(I, 5).Value = customer And Worksheets("Oracle").Cells(I, 19).Value > 0 And Trim(Worksheets("Oracle").Cells(I, 19).Value) <> "" And Trim(Worksheets("Oracle").Cells(I, 15).Value) = "" And (Trim(Worksheets("Oracle").Cells(I, 20).Value) = Trim(Worksheets("Oracle").Cells(I, 18).Value) Or Trim(Worksheets("Oracle").Cells(I, 20).Value) = "") Then
  40.   If Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 1 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 2 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 3 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 4 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 5 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 6 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 7 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 8 Or Left((Worksheets("Oracle").Cells(I, 22).Value), 1) = 9 Then
  41.   Set FRng = Worksheets(customer).Range("A:A").Find(Worksheets("Oracle").Cells(I, 1).Value, lookat:=xlWhole, SearchDirection:=xlPrevious)
  42.   If InStr(UCase(Worksheets("Oracle").Cells(I, 2).MergeArea(1)), "SPOT") = 0 And InStr(UCase(Worksheets("Oracle").Cells(I, 2).MergeArea(1)), "通内斯现货") = 0 Then
  43.   If FRng Is Nothing Then
  44.   Worksheets(customer).Cells(cnt, 1).Value = Worksheets("Oracle").Cells(I, 1).Value
  45.   Worksheets(customer).Cells(cnt, 2).Value = Worksheets("Oracle").Cells(I, 24).Value
  46.   Worksheets(customer).Cells(cnt, 3).Value = Worksheets("Oracle").Cells(I, 14).Value
  47.   If IsError(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) Then Worksheets(customer).Cells(cnt, 8).Value = "待通知" Else If Trim(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) = "" Then Worksheets(customer).Cells(cnt, 8).Value = "待通知" Else Worksheets(customer).Cells(cnt, 8).Value = Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)
  48.   Worksheets(customer).Cells(cnt, 19).Value = Left((Worksheets("Oracle").Cells(I, 22).Value), 3)
  49.   Worksheets(customer).Cells(cnt, 9).Value = "USD" & Format(Worksheets("Oracle").Cells(I, 19).Value * Worksheets(customer).Cells(cnt, 19).Value, "#.00")
  50.   Worksheets(customer).Cells(cnt, 19).Value = ""
  51.   
  52.   If Left((Worksheets("Oracle").Cells(I, 1).Value), 1) = 8 Then
  53.     s1 = Left((Worksheets("Oracle").Cells(I, 22).Value), 3) & "定金"
  54.     s2 = "          代理:" & Worksheets("Oracle").Cells(I, 10).Value
  55.     s3 = " 美國 "
  56.     S = s1 & "               合同金額：USD" & Worksheets("Oracle").Cells(I, 19).Value & "          目的港：" & Worksheets("Oracle").Cells(I, 26).Value & s2 & s3
  57.     With Worksheets(customer).Cells(cnt, 10)
  58.     .Value = S
  59.     .Characters(InStr(S, s1), Len(s1)).Font.Color = vbRed
  60.     .Characters(InStr(S, s2), Len(s2)).Font.Color = -16777024
  61.     .Characters(InStr(S, s3), Len(s3)).Font.Color = vbBlue
  62.     .Value = T_S_Cvt(.Value, 1)
  63.     End With
  64.   End If
  65.   
  66.   If Left((Worksheets("Oracle").Cells(I, 1).Value), 1) = 2 Then
  67.     s1 = Left((Worksheets("Oracle").Cells(I, 22).Value), 3) & "定金"
  68.     s2 = "          代理:" & Worksheets("Oracle").Cells(I, 10).Value
  69.     s3 = " 瑞士"
  70.     S = s1 & "               合同金額：USD" & Worksheets("Oracle").Cells(I, 19).Value & "          目的港：" & Worksheets("Oracle").Cells(I, 26).Value & s2 & s3
  71.    With Worksheets(customer).Cells(cnt, 10)
  72.    .Value = S
  73.    .Characters(InStr(S, s1), Len(s1)).Font.Color = vbRed
  74.    .Characters(InStr(S, s2), Len(s2)).Font.Color = -16777024
  75.    .Characters(InStr(S, s3), Len(s3)).Font.Color = vbBlue
  76.    .Value = T_S_Cvt(.Value, 1)
  77.    End With
  78.   End If
  79.   
  80.   Worksheets(customer).Cells(cnt, 12).Value = Worksheets("Oracle").Cells(I, 19).Value
  81.   Worksheets(customer).Cells(cnt, 15).Value = Worksheets("Oracle").Cells(I, 22).Value
  82.   Worksheets(customer).Cells(cnt, 11).Value = Worksheets("Oracle").Cells(I, 15).Value
  83.   If IsError(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) Then Worksheets(customer).Cells(cnt, 13).Value = Worksheets("Oracle").Cells(I, 28).Value Else Worksheets(customer).Cells(cnt, 13).Value = Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:C"), 2, False)
  84.   Worksheets(customer).Cells(cnt, 14).Value = Worksheets("Oracle").Cells(I, 27).Value
  85.   If IsError(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) Then Worksheets(customer).Cells(cnt, 16).Value = "" Else Worksheets(customer).Cells(cnt, 16).Value = Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:Q"), 17, False)
  86.   If IsError(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) Then Worksheets(customer).Cells(cnt, 17).Value = "" Else Worksheets(customer).Cells(cnt, 17).Value = Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:E"), 5, False)
  87.   If IsError(Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:B"), 2, False)) Then Worksheets(customer).Cells(cnt, 18).Value = Worksheets("Oracle").Cells(I, 25).Value Else Worksheets(customer).Cells(cnt, 18).Value = Application.VLookup(Worksheets(customer).Cells(cnt, 1).Value, Sheets("State").Range("A:X"), 24, False)
  88.   Worksheets(customer).Cells(cnt, 19).Value = Worksheets("Oracle").Cells(I, 18).Value
  89.   If Trim(Worksheets("Oracle").Cells(I, 8).Value) = "" Then Worksheets(customer).Cells(cnt, 5).Value = "沒有" Else Worksheets(customer).Cells(cnt, 5).Value = "有"
  90.   If Worksheets(customer).Cells(cnt, 5).Value = "沒有" Then Worksheets(customer).Cells(cnt, 5).Font.Color = vbRed
  91.   Worksheets(customer).Cells(cnt, 4).Value = Worksheets("Oracle").Cells(I, 7).Value
  92.   Worksheets(customer).Cells(cnt, 6).Value = Worksheets("Oracle").Cells(I, 12).Value
  93.   If Trim(Worksheets("Oracle").Cells(I, 27).Value) = "" Then Worksheets(customer).Cells(cnt, 7).Value = "待通知" Else Worksheets(customer).Cells(cnt, 7).Value = Worksheets("Oracle").Cells(I, 27).Value
  94.   With Worksheets(customer).Range(Worksheets(customer).Cells(cnt, 1), Worksheets(customer).Cells(cnt, 10))

  96.         .Borders.LineStyle = 1

  98.         .Borders.LineStyle = 1

  100.         .Borders.ColorIndex = 0

  102.         .BorderAround , 2, 0

  104.     End With
  105.   cnt = cnt + 1
  106.   d = d + 1
  107.   e = e + 1
  108.     End If
  109.    End If
  110.     End If
  111.    End If
  112.     Next I
  113.   Loop Until y > z
  114. Application.ScreenUpdating = True

  116.     wrdApp.Close False
  117. End Sub
  118. Public Function T_S_Cvt(strData, bytOption) As String

  120.     With wrdApp

  122.         .Content = strData

  124.         ' 調用 Word TCSCConverter 方法來轉換繁簡體

  126.         .Range.TCSCConverter bytOption, True, True

  128.         T_S_Cvt = .Content

  130.     End With

  132. End Function
複製代碼
回復 3# c_c_lai

.content = strData 出現RUN-TIME ERROR'424': Object required
作者: c_c_lai    時間: 2014-7-7 19:37

回復 4# 198188
在你目前的程式碼看來，不出錯才怪！
請仔細看看範例，問題出在哪裡？
你呼叫的物件根本不存在啊。
作者: c_c_lai    時間: 2014-7-7 20:24

本帖最後由 c_c_lai 於 2014-7-7 20:26 編輯

回復 4# 198188
想想還是直接給你答案吧！
為了要處理『轉簡體字或者繁體字』，我們引用了
Word 的物件：
  1. Set wrdApp = CreateObject("Word.Document")
複製代碼
但在設定之前，必須要預先宣告一個 wrdApp 物件 (Object)，
在你目前的程式碼雖然有宣告此變數：
  1.     Dim wrdApp As Object
複製代碼
但卻忽略了 .Value = T_S_Cvt(.Value, 1) 的 Function Call 內的內容引用，
  1. Public Function T_S_Cvt(strData, bytOption) As String
  2.     With wrdApp
  3.         .Content = strData
  4.         ' 調用 Word TCSCConverter 方法來轉換繁簡體
  5.         .Range.TCSCConverter bytOption, True, True
  6.         T_S_Cvt = .Content
  7.     End With
  8. End Function
複製代碼
結果除了 SCHPN() 外卻找不著 wrdApp 的物件，
到此你已經了解問題之所在了嗎？

如果還不明瞭，請注意你是在何處宣告 wrdApp 的。
目前 wrdApp 只能在  SCHPN() 裏頭可被識別，出了 SCHPN()
外便會產生：
  1. RUN-TIME ERROR '424': Object required
複製代碼
因為 T_S_Cvt() 內無法識別 wrdApp， 所以它才告訴你
『此處需要物件』。
總結，你必須在 SCHPN() 上頭需告：
  1. Dim wrdApp As Object
  2. Sub SCHPN()
複製代碼
而非在 SCHPN() 裏頭宣告；如此 wrdApp 才能成為『外域變數』。
T_S_Cvt() 才得以正確執行。
作者: c_c_lai    時間: 2014-7-7 20:55

回復 4# 198188
再補充說明：
[attach]18643[/attach]
作者: 198188    時間: 2014-7-8 14:44

回復 3# c_c_lai


    明白，已經解決，謝謝
作者: c_c_lai    時間: 2014-7-8 15:45

回復 8# 198188
如果你覺得 wrdApp 無必要宣告為『外域變數』(Global Variable)
那亦可修正成為『區域變數』(Local Variable)，但是引用之功能函式
則必須加以修改成，即必須同時帶入 wrdApp 物件 (引入參數)：
  1. Public Function T_S_Cvt(wrdApp, strData, bytOption) As String
  2.     With wrdApp
  3.         .Content = strData
  4.         ' 調用 Word TCSCConverter 方法來轉換繁簡體
  5.         .Range.TCSCConverter bytOption, True, True
  6.         T_S_Cvt = .Content
  7.     End With
  8. End Function
複製代碼
如此，便能直接在呼叫它的函式內去直接使用它了。
  1. Sub Test()
  2.     Dim wrdApp As Object
  3.     Dim s1 As String, s2 As String
  4.   
  5.     Set wrdApp = CreateObject("Word.Document")
  6.     Application.ScreenUpdating = False
  7.    
  8.     s1 = "發票金額：USD350.00"
  9.     s2 = "               目的港：台灣基隆港"
  10.     s = s1 & "          箱數:120箱" & "               櫃號:LSK122345P78" & s2
  11.   
  12.     With Worksheets("工作表1").Cells(1, 1)
  13.         .Value = s
  14.         ' 1 繁轉簡  0 簡轉繁
  15.         .Value = T_S_Cvt(wrdApp, .Value, 1)
  16.         ' .Value = T_S_Cvt(wrdApp, .Value, 0)
  17.         
  18.         .Characters(InStr(s, s1), Len(s1)).Font.Color = vbRed
  19.         .Characters(InStr(s, s2), Len(s2)).Font.Color = vbBlue
  20.     End With
  21.    
  22.     Application.ScreenUpdating = True
  23.     wrdApp.Close False
  24. End Sub
複製代碼
祝你順意！
作者: 198188    時間: 2015-3-13 10:39

回復 9# c_c_lai


    我發現用這個方法，會有個問題出來，就是不斷製造一些隱藏的word，每次關機都會顯示要不要儲存word.



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)