The Will Will Web

我們為了大量更新 Office 文件內容，加速更新速度的方式，就是修改 Application.ScreenUpdating = False

因為你每做一個指令，就會造成畫面更新，如果你的文件有上千頁，速度就會被拖的很慢，所以最快的方式就是先通知 Office 先不要更新畫面，等做完再更新！

 Sub 刪除文件中所有圖片()
 '
 ' 範例：刪除文件中所有圖片
 '
 '
     Application.ScreenUpdating = False
    
     Selection.HomeKey Unit:=wdStory
    
     Selection.Find.ClearFormatting
     With Selection.Find
         .Text = "^g"
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchByte = True
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
    
     While Selection.Find.Execute
         Selection.Delete Unit:=wdCharacter, Count:=1
     Wend
    
     Application.ScreenRefresh
    
     Application.ScreenUpdating = True
    
 End Sub

' 將傳進來的半型數字字串轉成國字大寫
' -------------------------------------------
Function 轉國字(s As String) As String
　　Dim s1 As String
　　Dim s2 As Long
　　If s = "" Then 轉國字 = "未輸入金額": Exit Function
　　While Left(s, 1) = "0": s = Right(s, Len(s) - 1): Wend
　　tmp節名 = "元萬億兆京"
　　節數 = (Len(s) - 1) \ 4 + 1
　　位數 = 節數 * 4
　　s = Right("0000" & s, 位數)
　　For i = 節數 To 1 Step -1
　　　　個位名 = Mid(tmp節名, i, 1)
　　　　s1 = Mid(s, ((節數 - i) * 4) + 1, 4)
　　　　zero = ""
　　　　If Left(s1, 1) = "0" Then zero = "零"
　　　　tmp = tmp & zero & 轉四位數(s1) & 個位名
　　Next
　　If Left(tmp, 1) = "零" Then tmp = Right(tmp, Len(tmp) - 1)
　　tmp = Replace(tmp, "零零", "零")
　　tmp = Replace(tmp, "零萬", "")
　　tmp = Replace(tmp, "零億", "")
　　tmp = Replace(tmp, "零元", "元")
　　轉國字 = tmp & "整"
End Function

Function 轉四位數(s As String) As String
　　If s = "0000" Then 轉四位數 = "零": Exit Function
　　While Left(s, 1) = "0": s = Right(s, Len(s) - 1): Wend
　　s = StrReverse(s)
　　tmp位名 = "　拾佰仟"
　　tmp國字 = "零壹貳參肆伍陸柒捌玖"
　　For i = 1 To Len(s)
　　　　英數字 = Mid(s, i, 1)
　　　　國數字 = Mid(tmp國字, 英數字 + 1, 1)
　　　　位名 = Mid(tmp位名, i, 1): If 英數字 = "0" Then 位名 = ""
　　　　結果 = 國數字 & 位名 & 結果
　　Next
　　結果 = Replace(結果, "零零零", "零")
　　結果 = Replace(結果, "零零", "零")
　　If Right(結果, 1) = "零" Then 結果 = Left(結果, Len(結果) - 1)
　　轉四位數 = Trim(結果)
End Function

Private Sub Command1_Click()
　　Debug.Print 轉國字("1234567890123")
　　Debug.Print 轉國字("10003000")
　　Debug.Print 轉國字("1502000")
　　Debug.Print 轉國字("10000000000")
　　Debug.Print 轉國字("100000000000000")
End Sub

' 將傳進來的英文字串轉成全形英文

Function ChgToAll(Word As String) As String
    Dim WoAll As String
    Dim NewWord As String
    NewWord = ""
    WoAll = "ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ"
    For i = 1 To Len(Word)
        If Asc(Mid(Word, i, 1)) - 65 >= 0 And Asc(Mid(Word, i, 1)) - 65 <= 25 Then
            NewWord = NewWord + Mid(WoAll, Asc(Mid(Word, i, 1)) - 65 + 1, 1)
        Else
            NewWord = NewWord + Mid(Word, i, 1)
        End If
    Next i

    ChgToAll = NewWord
End Function