返回列表 上一主題 發帖

[發問] 請問如何讓出來的文字不同顏色及轉簡體字或者繁體字

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-7-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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 ”這段的文字要藍色

還有可否出來後把所有文件轉簡體字或者繁體字？
收藏 分享

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-7-8 
2#
發表於 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

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-7-8 
3#
發表於 2014-7-8 14:44 | 顯示全部帖子
回復 3# c_c_lai


    明白，已經解決，謝謝

TOP

198188

帖子
438 
主題
67 
精華
0 
積分
531 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2012-10-30 
最後登錄
2025-7-8 
4#
發表於 2015-3-13 10:39 | 顯示全部帖子
回復 9# c_c_lai


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

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
返回列表 上一主題