返回列表 上一主題 發帖

有沒有任何辦法鎖死整個活頁薄字體 (新細明體 + Arial)

回復 1# jakcy1234
是這樣嗎?

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# jakcy1234
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim C As Range, i As Integer
  4.     For Each C In ActiveSheet.UsedRange
  5.         For i = 1 To Len(C)
  6.             If Asc(Mid(C, i, 1)) >= 0 And Asc(Mid(C, i, 1)) <= 255 Then
  7.                 C.Characters(Start:=i, Length:=i).Font.Name = "Arial"
  8.             Else
  9.                 C.Characters(Start:=i, Length:=i).Font.Name = "新細明體"
  10.             End If
  11.         Next
  12.     Next
  13. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# jakcy1234
  1. If Len(rCell.Text) > 1 Or   Val(rCell.Value) > 1 Then
  2.                rCell.Font.Name = "Arial"
  3.             Else
  4.                 rCell.Font.Name = "Arial"
  5.            End If
複製代碼
這程式碼不管有無 IF 判斷式,都是執行 rCell.Font.Name = "Arial"
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 8# jakcy1234
這不與你5#的程式碼一樣?
  1. Option Explicit
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     Dim rCell As Range
  4.     Application.EnableEvents = False
  5.     For Each rCell In Target
  6.         rCell.Font.Name = "Arial"           ' 一樣的 字型
  7.         '********************************************************
  8.         'If Len(rCell.Text) > 1 Or Val(rCell.Value) > 1 Then   '*
  9.          '       rCell.Font.Name = "Arial"  ' 一樣的 字型      '*
  10.         'Else                                                  '*
  11.         '        rCell.Font.Name = "Arial"  ' 一樣的 字型      '*
  12.         'End If                                                '*
  13.         '********************************************************
  14.     Next
  15.     Application.EnableEvents = True
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題