Quantcast
Channel: Daily Dose of Excel » Michael
Viewing all articles
Browse latest Browse all 10

VBE Code Indenter for the Macintosh

$
0
0

I lived in two worlds. My work was done on a PC, but my home computer has been a Mac since the Mac Plus. One thing my work PC had that my Mac never did was a code indenter for prettifying macro code. I’m partial to Stephen Bullen’s “Smart Indenter,” but others exist, such as Andrew Engwirda’s, found over here. Neither one works on a Mac because the Mac doesn’t have the same innards in the editing environment. “Never did” was until a free snowy weekend, when I wrote one in AppleScript. AppleScript exists on any Mac, and this script will indent any VBA routine. It uses a stack (implemented as an AppleScript list.) For an indent you push the stack, and for an out-dent you pop the stack. Two of the trigger phrases are more complicated. Else (and Else If) need an out-dent followed by an indent, or a pop and a push. Case requires an indent for the first one, an out-dent and an indent for the following ones, and then since End Select closes out Case, two out-dents, or two pops.

There’s probably a way to get to the editor’s native elements, but I couldn’t find it. I scripted the GUI instead. Here’s the script. AppleScript is about as self-documenting as it gets.

set TabSize to 3 -- spaces per tab.  Adjust to suit
set AlignDimAsToTabs to true -- Adjust to suit
set PutDimAsAtTab to 7 -- Adjust to suit
set OldCode to ""
set NewCode to ""
set templine to ""
set Tabs to 0
set Stack to {1}
set CaseStack to {}
set ThisLine to {}
set NoTabs to {"Option Explicit", "Sub", "Private", "Public", "Function", "Type", "Enum", "End Sub", "End Function"}
set OneTab to {"Dim", "ReDim", "Static", "Stop", "Debug", "#If", "#Else", "#End"}
set PushTabs to {"For", "With", "Do", "Select", "Case"}
set IfTabs to {"If", "Else", "End If"} --Push, Pop & Push, Pop
set PopTabs to {"Next", "End With", "Loop", "End Select"}
set the clipboard to OldCode
tell application "System Events"
    tell application id "com.microsoft.Excel" to activate
    tell application process "Microsoft Excel" --scripting the GUI
        set myList to (get name of windows)
        repeat with i from 1 to count of myList
            try
                if last word of item i of myList is "Code" then
                    exit repeat
                end if
            end try
        end repeat
        perform action "AXRaise" of window i
    end tell
    keystroke "a" using command down
    delay 1
    keystroke "c" using command down
    delay 1
    --if nothing happens, make sure your code window is frontmost.
end tell
set OldCode to the clipboard
set C to count of paragraphs of OldCode
set AppleScript's text item delimiters to space
repeat with N from 1 to C
    try
        set WasFound to false
        set LineOfCode to paragraph N of OldCode
        if length of LineOfCode > 1 then
            repeat while character 1 of LineOfCode is space
                if length of LineOfCode = 1 then exit repeat
                set LineOfCode to text 2 thru -1 of LineOfCode
            end repeat
            repeat with i from 1 to (count of characters of LineOfCode) - 1
                set char1 to character i of LineOfCode
                set char2 to character (i + 1) of LineOfCode
                if not (char1 is space and char2 is space) then
                    set templine to templine & char1
                end if
            end repeat
            set templine to templine & char2
            set LineOfCode to templine
            set templine to ""
                        set char2 to ""
        end if
        set L1 to length of LineOfCode
        if L1 > 1 then
            repeat with i from 1 to count of NoTabs
                set ItemText to item i of NoTabs
                set L2 to length of ItemText
                if L1 ≥ L2 then
                    if ItemText = text 1 thru L2 of LineOfCode then
                        set WasFound to true
                        exit repeat
                    end if
                end if
            end repeat
            if WasFound is false then
                repeat with i from 1 to count of OneTab
                    set ItemText to item i of OneTab
                    set L2 to length of ItemText
                    if L1 ≥ L2 then
                        if ItemText = text 1 thru L2 of LineOfCode then
                            if AlignDimAsToTabs is true and (ItemText = "Dim" or ItemText = "Static") and ¬
                                                                LineOfCode does not contain "(" then
                                set j to 1
                                repeat with i from 1 to count of characters of LineOfCode
                                    if character i of LineOfCode is space then
                                        set ThisLine to ThisLine & text j thru (i - 1) of LineOfCode
                                        set j to i + 1
                                    end if
                                end repeat
                                set ThisLine to ThisLine & text j thru i of LineOfCode
                                set x to (length of ItemText) + (length of item 2 of ThisLine) + 2
                                set y to TabSize * (PutDimAsAtTab - 1) --take one away, add it back below
                                set txt to "As"
                                repeat with i from 1 to (y - x)
                                    set txt to space & txt
                                end repeat
                                set item 3 of ThisLine to txt
                                set LineOfCode to ThisLine as string
                                set ThisLine to {}
                            end if
                            set Tabs to 1
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs) --add it back
                            set WasFound to true
                            exit repeat
                        end if
                    end if
                end repeat
            end if
            if WasFound is false then
                repeat with i from 1 to count of PushTabs
                    set ItemText to item i of PushTabs
                    if ItemText = first word of LineOfCode then
                        set Tabs to last item of Stack
                        if ItemText = "Select" then set CaseStack to CaseStack & (false) --push the stack
                        if ItemText = "Case" then
                            if last item of CaseStack is true then set Stack to pop_the_stack(Stack)
                            if last item of CaseStack is false then set the last item of CaseStack to true
                        end if
                        set Tabs to last item of Stack
                        set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                        set Stack to Stack & (Tabs + 1) --push the stack
                        set WasFound to true
                        exit repeat
                    end if
                end repeat
            end if
            if WasFound is false then
                repeat with i from 1 to count of IfTabs
                    set ItemText to item i of IfTabs
                    set L2 to length of ItemText
                    if L1 ≥ L2 then
                        if (ItemText = text 1 thru L2 of LineOfCode) and (last word of LineOfCode is not "Then") and (last character of LineOfCode is not "_") and (ItemText = "If") then --If...
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set WasFound to true
                            exit repeat
                        else if (ItemText = text 1 thru L2 of LineOfCode) and (ItemText = "Else") then --Else, Else If
                            set Stack to pop_the_stack(Stack)
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set Stack to Stack & (Tabs + 1) --push the stack
                            set WasFound to true
                            exit repeat
                        else if (ItemText = text 1 thru L2 of LineOfCode) and (last word of LineOfCode = "Then") then --If...Then
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set Stack to Stack & (Tabs + 1) --push the stack
                            set WasFound to true
                            exit repeat
                        else if (ItemText = text 1 thru L2 of LineOfCode) and (last character of LineOfCode = "_") then --If..._
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set Stack to Stack & (Tabs + 1) --push the stack
                            set WasFound to true
                            exit repeat
                           
                        else if ItemText = text 1 thru L2 of LineOfCode then --End If
                            set Stack to pop_the_stack(Stack)
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set WasFound to true
                            exit repeat
                        end if
                    end if
                end repeat
            end if
            if WasFound is false then
                repeat with i from 1 to count of PopTabs
                    set ItemText to item i of PopTabs
                    set L2 to length of ItemText
                    if L1 ≥ L2 then
                        if ItemText = text 1 thru L2 of LineOfCode then
                            if ItemText = "End Select" then
                                set CaseStack to pop_the_stack(CaseStack)
                                set Stack to pop_the_stack(Stack)
                            end if
                            set Stack to pop_the_stack(Stack)
                            set Tabs to last item of Stack
                            set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
                            set WasFound to true
                            exit repeat
                        end if
                    end if
                end repeat
            end if
            if WasFound is false then
                set Tabs to last item of Stack
                set LineOfCode to pad_the_line(LineOfCode, TabSize * Tabs)
            end if
        end if
        set NewCode to NewCode & LineOfCode & return
    on error error_message number error_number
        if error_number is -1728 then
            --Can’t get last item of {}.
            set alert_string to "Extra Code Block End" as string
            set AppleScript's text item delimiters to " or "
            set message_string to ¬
                ("There looks to be an extra code block end line of either \n{" & PopTabs as string) & ¬
                " or End If}\nin your code, as the Stack is empty {}. Ending. Your code is not changed."
            display alert alert_string message message_string as warning buttons {"OK"}
            set AppleScript's text item delimiters to ""
            return
        end if
    end try
end repeat

set the clipboard to ""
delay 0.5
set the clipboard to NewCode
tell application "System Events"
    tell application id "com.microsoft.Excel" to activate
    keystroke "v" using command down
end tell
if last item of Stack is not 1 then
    set alert_string to "Extra Code Block Start"
    set AppleScript's text item delimiters to " or "
    set message_string to ¬
        ("There looks to be an extra code block start line of either \n{" & PushTabs as string) & ¬
        " or If}\nin your code, as the Stack did not return to {1}."
    display alert alert_string message message_string buttons {"OK"} ¬
        giving up after 10
end if
set AppleScript's text item delimiters to ""

on pop_the_stack(this_list)
    set this_list to reverse of this_list
    set this_list to rest of this_list
    set this_list to reverse of this_list
    return this_list
end pop_the_stack

on pad_the_line(ThisLine, pad)
    repeat with j from 1 to pad
        set ThisLine to space & ThisLine
    end repeat
    repeat while last character of ThisLine is space
        set ThisLine to text 1 thru -2 of ThisLine
    end repeat
    return ThisLine
end pad_the_line

The script checks for two things: If the stack at the end is not {1}, then you have too many indents. AppleScript won’t complain, and the editor probably showed you it to you any way. On the other hand, if you have too many out-dents, you can’t pop an empty stack, and Applescript throws an error. The script above catches that, and makes no changes.

Stephen Bullen provides some sample code. I stole it, and added some of my own.

Option Explicit

'Example Procedure
Sub ExampleProc()

'Smart Indenter
'(c) 1998-2004 by Office Automation ltd.

Dim iCount As Integer
Static sName As String

If YouWantMoreExamplesAndTools Then
'Visit http://www.oaltd.co.uk

Select Case X
Case "A"
'If you have any comments or suggestions, _
or find valid VBA code that isn't indented correctly,

#If VBA6 Then
MsgBox "Please comment below."
#End If

Case "Continued strings and parameters can be" _
& "lined up for easier reading, optionally ignoring" _
, "any operators (&+, etc) at the start of the line."
'Not implemented in Applescript.

Debug.Print "X<>1"
End Select ' Case X
End If 'More Tools?
End Sub

Sub Proc()
Dim mrt As Double
Select Case Row
Case 1
Select Case Col
Case 1
action 1
Case 2
action 2
End Select
Case 2
Select Case Col
Case 1
action 3
Case 2
action 4
End Select
Case Else
action 5
End Select
End Sub

Running the script, it looks like this:

Option Explicit

   'Example Procedure
Sub ExampleProc()

   'Smart Indenter
   '(c) 1998-2004 by Office Automation ltd.

   Dim iCount        As Integer
   Static sName      As String

   If YouWantMoreExamplesAndTools Then
      'Visit http://www.oaltd.co.uk

      Select Case X
         Case "A"
            'If you have any comments or suggestions, _
            or find valid VBA code that isn't indented correctly,

   #If VBA6 Then
            MsgBox "Please comment below."
   #End If

         Case "Continued strings and parameters can be" _
            & "lined up for easier reading, optionally ignoring" _
            , "any operators (&+, etc) at the start of the line."
            'Not implemented in Applescript.

   Debug.Print "X<>1"
      End Select ' Case X
   End If 'More Tools?
End Sub

Sub Proc()
   Dim mrt           As Double
   Select Case Row
      Case 1
         Select Case Col
            Case 1
               action 1
            Case 2
               action 2
         End Select
      Case 2
         Select Case Col
            Case 1
               action 3
            Case 2
               action 4
         End Select
      Case Else
         action 5
   End Select
End Sub

I didn’t implement Stephen’s procedure/module/project choice, as I don’t think I can. The whole module page is prettified. And I didn’t reverse engineer his control of comments. Line comments go as the next line of code would be indented, and inline comments are as you put them. This script, suitably and easily modified, will work for MS Word macros, too. I tried to find the hooks that would ensure a code module was the front window in the editor, but I had no luck. If nothing happens, you may have the Project or Properties windows frontmost, and Select All and Copy are grayed out. Just click in your module, and you’ll be all set. If you want to change the category of a trigger phrase, it’s straight forward. You’ll have to pay attention to if the phrase is one word or two. If it’s two, you have to compare as text vice as words. Examples are in the script. And please, if you know the inner mechanisms of AppleScript and the VB Editor, leave a note.

…mrt
©¿©¬


Viewing all articles
Browse latest Browse all 10

Latest Images

Trending Articles



Latest Images