Could this VBA macro be written in AppleScripter

Scripting Forums AppleScript | Mac OS X
#1

I use this VBA macro in MS Word to get a word count in a specific color.

Sub HighlightedWordCount()
Dim objDoc As Document
Dim objWord As Range
Dim nHighlightedWords As Long
Dim strHighlightColor As String
Dim highlightColorName As String
Application.ScreenUpdating = False
Set objDoc = ActiveDocument
nHighlightedWords = 0
strHighlightColor = InputBox("Choose a highlight color (enter the value):" & vbNewLine & _
vbTab & "Auto" & vbTab & vbTab & "0" & vbNewLine & _
vbTab & "Black" & vbTab & vbTab & "1" & vbNewLine & _
vbTab & "Blue" & vbTab & vbTab & "2" & vbNewLine & _
vbTab & "Turquoise" & vbTab & vbTab & "3" & vbNewLine & _
vbTab & "BrightGreen" & vbTab & "4" & vbNewLine & _
vbTab & "Pink" & vbTab & vbTab & "5" & vbNewLine & _
vbTab & "Red" & vbTab & vbTab & "6" & vbNewLine & _
vbTab & "Yellow" & vbTab & vbTab & "7" & vbNewLine & _
vbTab & "White" & vbTab & vbTab & "8" & vbNewLine & _
vbTab & "DarkBlue" & vbTab & vbTab & "9" & vbNewLine & _
vbTab & "Teal" & vbTab & vbTab & "10" & vbNewLine & _
vbTab & "Green" & vbTab & vbTab & "11" & vbNewLine & _
vbTab & "Violet" & vbTab & vbTab & "12" & vbNewLine & _
vbTab & "DarkRed" & vbTab & vbTab & "13" & vbNewLine & _
vbTab & "DarkYellow" & vbTab & "14" & vbNewLine & _
vbTab & "Gray 50" & vbTab & vbTab & "15" & vbNewLine & _
vbTab & "Gray 25" & vbTab & vbTab & "16", "Pick Highlight Color")

If strHighlightColor = "" Then
' User pressed cancel button
Exit Sub
ElseIf Not IsNumeric(strHighlightColor) Then
MsgBox "Invalid input. Please enter a value between 1 and 16."
Exit Sub
Else
Dim inputNum As Integer
inputNum = CInt(strHighlightColor)
If inputNum < 1 Or inputNum > 16 Then
MsgBox "Invalid input. Please enter a value between 1 and 16."
Exit Sub
End If
End If

Select Case strHighlightColor
    Case "0"
        highlightColorName = "Auto"
    Case "1"
        highlightColorName = "Black"
    Case "2"
        highlightColorName = "Blue"
    Case "3"
        highlightColorName = "Turquoise"
    Case "4"
        highlightColorName = "BrightGreen"
    Case "5"
        highlightColorName = "Pink"
    Case "6"
        highlightColorName = "Red"
    Case "7"
        highlightColorName = "Yellow"
    Case "8"
        highlightColorName = "White"
    Case "9"
        highlightColorName = "DarkBlue"
    Case "10"
        highlightColorName = "Teal"
    Case "11"
        highlightColorName = "Green"
    Case "12"
        highlightColorName = "Violet"
    Case "13"
        highlightColorName = "DarkRed"
    Case "14"
        highlightColorName = "DarkYellow"
    Case "15"
        highlightColorName = "Gray 50"
    Case "16"
        highlightColorName = "Gray 25"
    Case Else
        highlightColorName = "unknown"
End Select

Dim S$
For Each objWord In objDoc.Words
If objWord.HighlightColorIndex = CInt(strHighlightColor) Then
    S = Trim(objWord.Text)
    If Len(S) = 1 Then
        Select Case S
            Case ".", ",", ";", ":", "!", "?", ChrW(171), ChrW(187), "$", "€", "%", "-", "+", "@", "#", "*", "^", "<", ">", "(", ")", "/", "\", "~", Chr(34), Chr(160), Space(1), Chr(255)
            'Do nothing or skip it. You can add more special characters to exclude them.
        Case Else
            nHighlightedWords = nHighlightedWords + 1
        End Select
    ElseIf Len(S) = 2 Then
        If (S = ChrW(171) & ChrW(160)) Or (S = ChrW(160) & ChrW(187)) Then 'Exclusion
            'Do nothing to ignore the special case: "«" + <nbsp> and "»" + <nbsp>
        Else
            nHighlightedWords = nHighlightedWords + 1
        End If
    Else
        nHighlightedWords = nHighlightedWords + 1
    End If
End If
Next objWord

Select Case strHighlightColor
Case "0"
highlightColorName = "Auto"
Case "1"
highlightColorName = "Black"
Case "2"
highlightColorName = "Blue"
Case "3"
highlightColorName = "Turquoise"
Case "4"
highlightColorName = "BrightGreen"
Case "5"
highlightColorName = "Pink"
Case "6"
highlightColorName = "Red"
Case "7"
highlightColorName = "Yellow"
Case "8"
highlightColorName = "White"
Case "9"
highlightColorName = "DarkBlue"
Case "10"
highlightColorName = "Teal"
Case "11"
highlightColorName = "Green"
Case "12"
highlightColorName = "Violet"
Case "13"
highlightColorName = "DarkRed"
Case "14"
highlightColorName = "DarkYellow"
Case "15"
highlightColorName = "Gray 50"
Case "16"
highlightColorName = "Gray 25"
Case Else
highlightColorName = "unknown"
End Select

MsgBox ("The number of alphanumeric words highlighted in " & highlightColorName & " is " & nHighlightedWords & ".")
Application.ScreenUpdating = True
Set objDoc = Nothing
End Sub

The Macro displays a dialog where the user is asked to enter a value that corresponds to the various stock Word highlight colors, and the word count is then displayed in a. second dialog.

Wondering if something similar could be achieved in AppleScript. I’d like to be able to get the word count through th Shortcuts app instead of a macro. Would that even be possible?

Cheers

#2

Try this script

use AppleScript version "2.4" -- Yosemite (10.10) or later
use scripting additions

property hColors : {"Auto", "Black", "Blue", "Turquoise", "Bright Green", "Pink", "Red", "Yellow", "White", "Dark Blue", "Teal", "Green", "Violet", "Dark Red", "Dark Yellow", "Gray 50", "Gray 25", "unknown"}

local myIndex
set myColor to choose from list hColors with title "Windows Hightlight Colors" with prompt "Please choose a highlight color..."
if class of myColor is boolean then return -- user chose 'Cancel'
set myColor to item 1 of myColor
set myIndex to getIndexOfItemInList(myColor, hColors)

tell application "Microsoft Word"
	set WordColor to item myIndex of {auto, black, blue, turquoise, bright green, pink, red, yellow, white, dark blue, teal, green, violet, dark red, dark yellow, gray50, gray25, no highlight}
	set wc to (words of document of window 1 whose highlight color index is WordColor)
	set wc to count wc
end tell
display alert "# of words with highlight color \"" & myColor & "\" is " & wc

on getIndexOfItemInList(theItem, theList)
	script L
		property aList : theList
	end script
	repeat with a from 1 to count of L's aList
		if item a of L's aList is theItem then return a
	end repeat
	return 0
end getIndexOfItemInList

** EDIT ** - I just noticed the skipping of special characters, will try later

#3

This worked perfectly. Thank you so much!!

#4

Here it is

use AppleScript version "2.4" -- Yosemite (10.10) or later
use scripting additions

property hColors : {"Auto", "Black", "Blue", "Turquoise", "Bright Green", "Pink", "Red", "Yellow", "White", "Dark Blue", "Teal", "Green", "Violet", "Dark Red", "Dark Yellow", "Gray 50", "Gray 25", "unknown"}

local myIndex, nHighlightedWords
set myColor to choose from list hColors with title "Windows Hightlight Colors" with prompt "Please choose a highlight color..."
if class of myColor is boolean then return -- user chose 'Cancel'
set myColor to item 1 of myColor
set myIndex to getIndexOfItemInList(myColor, hColors)
set nHighlightedWords to 0
tell application "Microsoft Word"
	set WordColor to item myIndex of {auto, black, blue, turquoise, bright green, pink, red, yellow, white, dark blue, teal, green, violet, dark red, dark yellow, gray50, gray25, no highlight}
	set wordList to (words of document of window 1 whose highlight color index is WordColor)
	set wc to count wordList
	repeat with i from 1 to wc
		set aWord to item i of wordList
		if highlight color index of aWord is WordColor then
			set ws to my trimSpace(content of aWord)
			set wl to length of ws
			if wl = 1 then
				if ws is not in {".", ",", ";", ":", "!", "?", "«", "»", "$", "€", "%", "-", "+", "@", "#", "*", "^", "<", ">", "(", ")", "/", "\\", "~"} then
					set nHighlightedWords to nHighlightedWords + 1
				end if
			else if wl = 2 then
				if ws is not {"« ", " »"} then
					set nHighlightedWords to nHighlightedWords + 1
				end if
			else
				set nHighlightedWords to nHighlightedWords + 1
			end if
		end if
	end repeat
end tell
display alert "# of words with highlight color \"" & myColor & "\" is " & nHighlightedWords

on getIndexOfItemInList(theItem, theList)
	script L
		property aList : theList
	end script
	repeat with a from 1 to count of L's aList
		if item a of L's aList is theItem then return a
	end repeat
	return 0
end getIndexOfItemInList

on trimSpace(aString)
	local i
	repeat with i from 1 to (length of aString)
		if text i of aString ≠ " " then
			exit repeat
		end if
	end repeat
	set aString to text i thru -1 of aString
	repeat with i from length of aString to 1 by -1
		if text i of aString ≠ " " then
			exit repeat
		end if
	end repeat
	return text 1 thru i of aString
end trimSpace
1 Like
#5

That’s great. Thanks again!

#6

Hello. I’m running into an issue. The script you kindly provided works for short texts, but I routinely work on documents that are 5000-10 000 word long. When I run the script on one of those, I get the beach ball and everything freezes. And idea what could be the issue and how to fix it?

Thank you.

#7

Microsoft is horribly slow at using whose clauses.
It would probably be better to get all the words first then parse them out based on highlight using native AppleScript.

I’ll try to rewrite later

#8

I got it!

try this…

use AppleScript version "2.4" -- Yosemite (10.10) or later
use scripting additions

property hColors : {"Auto", "Black", "Blue", "Turquoise", "Bright Green", "Pink", "Red", "Yellow", "White", "Dark Blue", "Teal", "Green", "Violet", "Dark Red", "Dark Yellow", "Gray 50", "Gray 25", "unknown"}

on run
	local myDoc, myResult, i, wc, wordList, WordColor, myIndex, nHighlightedWords, ws, wl, psteps
	set myColor to choose from list hColors with title "Windows Hightlight Colors" with prompt "Please choose a highlight color..."
	if class of myColor is boolean then return -- user chose 'Cancel'
	set WordColor to item 1 of myColor
	set myIndex to getIndexOfItemInList(WordColor, hColors)
	set nHighlightedWords to 0
	tell application "Microsoft Word"
		if not (exists window 1) then return
		set wc to count (words of document 1)
		set WordColor to item myIndex of {auto, black, blue, turquoise, bright green, pink, red, yellow, white, dark blue, teal, green, violet, dark red, dark yellow, gray50, gray25, no highlight}
		set my progress description to "Getting MS-Word highlight colors…"
		set my progress total steps to 100
		set my progress completed steps to 0
		set psteps to wc div 100
		repeat with i from 1 to wc
			set myResult to highlight color index of word i of document 1
			if myResult is WordColor then
				set ws to my trimSpace(content of word i of document 1)
				set wl to length of ws
				if wl = 1 then
					if ws is not in {".", ",", ";", ":", "!", "?", "«", "»", "$", "€", "%", "-", "+", "@", "#", "*", "^", "<", ">", "(", ")", "/", "\\", "~"} then
						set nHighlightedWords to nHighlightedWords + 1
					end if
				else if wl = 2 then
					if ws is not {"« ", " »"} then
						set nHighlightedWords to nHighlightedWords + 1
					end if
				else
					set nHighlightedWords to nHighlightedWords + 1
				end if
			end if
			if (i mod psteps) = 0 then
				set my progress completed steps to (my progress completed steps) + 1
				set my progress additional description to "(" & i & " of " & wc & ") " & (myResult as text) & ", \"" & (content of word i of document 1) & "\""
			end if
			--delay 0.2
		end repeat
	end tell
	display alert "# of words with highlight color \"" & myColor & "\" is " & nHighlightedWords
end run

on getIndexOfItemInList(theItem, theList)
	script L
		property aList : theList
	end script
	repeat with a from 1 to count of L's aList
		if item a of L's aList is theItem then return a
	end repeat
	return 0
end getIndexOfItemInList

on trimSpace(aString)
	local i
	repeat with i from length of aString to 1 by -1
		if text i of aString ≠ " " then
			exit repeat
		end if
	end repeat
	return text 1 thru i of aString
end trimSpace

it may not be fast, but it works and won’t error time-out on large files.

AppleScript to delete any non-highlighted word in a Word doc
#9

Hi Robert,

Thanks for all your help on this. Yes, it is not fast but it does work. I am wondering if the approach I mentioned in that other thread i.e. a script that deletes any non-highlighted text (or any text not highlighted in a specific color if that is possible) and using Word’s word counter would be more efficient.