T
_tst_
Guest
I have been working on (what I first believed to be) a small project for my company, in which I attempted to ease some collegues pains having to manually format Word documents for clients. In this specific case, we need to automatically change Font of all Chinese characters in a given document to SimSun/SimHei (for non-Bold and Bold fonts respectively).
We first tried to record a macro, which only deleted all chinese text. So never having coded in VBA, I started to get into it. Wth a lot of help from other forums, I finally managed to not just replace regular text, but also text found in the headers and footers (which I didnt know had to be processed separately).
The code that I have now successfully changes text into the specific font:
Sub Font_Macro()
' from Arial to SimSun (normal) or SimHei (bold)
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter
Dim FirstLineInd As Paragraph
With ActiveDocument
For Each Rng In .StoryRanges
Call FindReplace_zh(Rng)
Next
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt.Range.Paragraphs
HdFirstLineInd = .FirstLineIndent
End With
With HdFt
If .LinkToPrevious = False Then
Call FindReplace_zh(HdFt.Range)
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
Call FindReplace_zh(HdFt.Range)
End If
End With
Next
Next
End With
End Sub
Sub FindReplace_zh(Rng As Range)
With Rng.Find
.ClearFormatting
.Font.Bold = True
.Font.Hidden = False
.MatchWildcards = True
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Name = "SimHei"
.Text = "\1"
End With
.Execute Format:=True, Replace:=wdReplaceAll
End With
With Rng.Find
.ClearFormatting
.Font.Bold = False
.Font.Hidden = False
.MatchWildcards = True
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
.ClearFormatting
.Font.Bold = False
.Font.Name = "SimSun"
.Text = "\1"
End With
.Execute Format:=True, Replace:=wdReplaceAll
End With
End Sub
It works well enough...
My biggest complain is that VBA is incapable of using normal regular experessions, like "\W" or even more complex ones, like "\p{Han}", which would be perfect for my specific scenario, but because it doesn't, I have to resort to attrocious blocks of strings like this:
[!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])
If there is a better way, please let me know, because I had to spent hours searching the web and trial-and-error'ing this list to encompass as many special characters as possible (I still don't know how to add brackets. VB won't let me add them straigt up and escaping them with either \ or ^ doesn't work either)
One the most baffling things though is this:
When I tried to narrow the search parameter to only replace text with the new fonts that originally was set to Arial, like so:
With Rng.Find
.ClearFormatting
.Font.Bold = False
.Font.Hidden = False
.MatchWildcards = True
.Font.Name = "Arial"
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
The macro just stops working outright. I cannot think for a reason why. Doing a different approach, like exempting certain fonts (like Wingdings) like so
.Font.Name Not "Wingdings"
.Font.Name <> "Wingdings"
(Why can't I just use != and be done with it?)
also doesn't work. The code will either not compile or throw an exception.
If you have any ideas, bright insights or anything that could help out, it would be much appreciated. I am used to coding in python (in fact, I wrapped this Macro and others into a python script that applies them in bulk, which took significantly less time to code that this monstrocity, and it still doesn't work right)
Thank you
- tst
Continue reading...
We first tried to record a macro, which only deleted all chinese text. So never having coded in VBA, I started to get into it. Wth a lot of help from other forums, I finally managed to not just replace regular text, but also text found in the headers and footers (which I didnt know had to be processed separately).
The code that I have now successfully changes text into the specific font:
Sub Font_Macro()
' from Arial to SimSun (normal) or SimHei (bold)
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter
Dim FirstLineInd As Paragraph
With ActiveDocument
For Each Rng In .StoryRanges
Call FindReplace_zh(Rng)
Next
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt.Range.Paragraphs
HdFirstLineInd = .FirstLineIndent
End With
With HdFt
If .LinkToPrevious = False Then
Call FindReplace_zh(HdFt.Range)
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
Call FindReplace_zh(HdFt.Range)
End If
End With
Next
Next
End With
End Sub
Sub FindReplace_zh(Rng As Range)
With Rng.Find
.ClearFormatting
.Font.Bold = True
.Font.Hidden = False
.MatchWildcards = True
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.Name = "SimHei"
.Text = "\1"
End With
.Execute Format:=True, Replace:=wdReplaceAll
End With
With Rng.Find
.ClearFormatting
.Font.Bold = False
.Font.Hidden = False
.MatchWildcards = True
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
.ClearFormatting
.Font.Bold = False
.Font.Name = "SimSun"
.Text = "\1"
End With
.Execute Format:=True, Replace:=wdReplaceAll
End With
End Sub
It works well enough...
My biggest complain is that VBA is incapable of using normal regular experessions, like "\W" or even more complex ones, like "\p{Han}", which would be perfect for my specific scenario, but because it doesn't, I have to resort to attrocious blocks of strings like this:
[!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])
If there is a better way, please let me know, because I had to spent hours searching the web and trial-and-error'ing this list to encompass as many special characters as possible (I still don't know how to add brackets. VB won't let me add them straigt up and escaping them with either \ or ^ doesn't work either)
One the most baffling things though is this:
When I tried to narrow the search parameter to only replace text with the new fonts that originally was set to Arial, like so:
With Rng.Find
.ClearFormatting
.Font.Bold = False
.Font.Hidden = False
.MatchWildcards = True
.Font.Name = "Arial"
.Text = "([!A-ZÄÖÜa-zäöü0-9>< ^11^13§$%&/\_-])"
With .Replacement
The macro just stops working outright. I cannot think for a reason why. Doing a different approach, like exempting certain fonts (like Wingdings) like so
.Font.Name Not "Wingdings"
.Font.Name <> "Wingdings"
(Why can't I just use != and be done with it?)
also doesn't work. The code will either not compile or throw an exception.
If you have any ideas, bright insights or anything that could help out, it would be much appreciated. I am used to coding in python (in fact, I wrapped this Macro and others into a python script that applies them in bulk, which took significantly less time to code that this monstrocity, and it still doesn't work right)
Thank you
- tst
Continue reading...