Improvements to VBA's Heuristic (#7079)

* Revert "Fix VBA heuristic for Access Option Compare statement (#6742)"

This reverts commit 94e7b20.

* Add Word objects

This should fix detection in this file:
https://github.com/oscarsun72/WordVBA/blob/master/TableOps.bas

* Simplify VBA heuristic + sample

* Add VB6 sample with "Option Compare Binary"

* Add VBA Word sample

lib/linguist/heuristics.yml

@@ -95,9 +95,7 @@ disambiguations:
   - language: BASIC
     pattern: '\A\s*\d'
   - language: VBA
-    and:
-    - named_pattern: vb-module
-    - named_pattern: vba
+    named_pattern: vba
   - language: Visual Basic 6.0
     named_pattern: vb-module
 - extensions: ['.bb']
@@ -957,12 +955,12 @@ named_patterns:
   - '^[ ]*#If Win64\b'
   - '^[ ]*(?:Dim|Const) [0-9a-zA-Z_]*[ ]*As Long(?:Ptr|Long)\b'
   # Top module declarations unique to VBA
-  - '^[ ]*Option (?:Private Module|Compare (?:Database|Text|Binary))\b'
+  - '^[ ]*Option (?:Private Module|Compare Database)\b'
   # General VBA libraries and objects
   - '(?: |\()(?:Access|Excel|Outlook|PowerPoint|Visio|Word|VBIDE)\.\w'
   - '\b(?:(?:Active)?VBProjects?|VBComponents?|Application\.(?:VBE|ScreenUpdating))\b'
   # AutoCAD, Outlook, PowerPoint and Word objects
-  - '\b(?:ThisDrawing|AcadObject|Active(?:Explorer|Inspector|Window\.Presentation|Presentation|Document)|Selection\.(?:Find|Paragraphs))\b'
+  - '\b(?:ThisDrawing|AcadObject|Active(?:Explorer|Inspector|Window\.Presentation|Presentation|Document)|Selection\.(?:Document|Find|Paragraphs|Range))\b'
   # Excel objects
   - '\b(?:(?:This|Active)?Workbooks?|Worksheets?|Active(?:Sheet|Chart|Cell)|WorksheetFunction)\b'
   - '\b(?:Range\(".*|Cells\([0-9a-zA-Z_]*, (?:[0-9a-zA-Z_]*|"[a-zA-Z]{1,3}"))\)'

samples/VBA/QuickCards.bas

@@ -0,0 +1,205 @@
+Attribute VB_Name = "QuickCards"
+Option Explicit
+
+Public Sub AddQuickCard()
+    Dim Profile As String
+    Dim t As Template
+    Dim Name As String
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+
+    On Error GoTo Handler
+
+    If Selection.Start = Selection.End Then
+        MsgBox "You must select some text to save a Quick Card", vbOKOnly
+        Exit Sub
+    End If
+
+    Name = InputBox("What shortcut word/phrase do you want to use for your Quick Card? Usually this is the author's last name.", "Add Quick Card", "")
+    If Name = "" Then Exit Sub
+
+    Profile = GetSetting("Verbatim", "QuickCards", "QuickCardsProfile", "Verbatim1")
+    If Not Profile Like "Verbatim*" Then Profile = "Verbatim1"
+
+    Set t = ActiveDocument.AttachedTemplate
+
+    For i = 1 To t.BuildingBlockTypes.Count
+        If t.BuildingBlockTypes.Item(i).Name = "Custom 1" Then
+            For j = 1 To t.BuildingBlockTypes.Item(i).Categories.Count
+                If t.BuildingBlockTypes.Item(i).Categories.Item(j).Name = Profile Then
+                    For k = 1 To t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Count
+                        If LCase$(t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Name) = LCase$(Name) Then
+                            MsgBox "There's already a Quick Card with that name, try again with a different name!", vbOKOnly, "Failed To Add Quick Card"
+                            Exit Sub
+                        End If
+                    Next k
+                End If
+            Next j
+        End If
+    Next i
+
+    t.BuildingBlockEntries.Add Name, wdTypeCustom1, Profile, Selection.Range
+
+    t.Save
+
+    Ribbon.RefreshRibbon
+
+    MsgBox "Successfully created Quick Card with the shortcut """ & Name & """"
+
+    Set t = Nothing
+    Exit Sub
+
+Handler:
+    Set t = Nothing
+    MsgBox "Error " & Err.Number & ": " & Err.Description
+End Sub
+
+'@Ignore ProcedureNotUsed
+Public Sub InsertCurrentQuickCard()
+    On Error Resume Next
+    Selection.Range.InsertAutoText
+    On Error GoTo 0
+End Sub
+
+Public Sub InsertQuickCard(ByRef QuickCardName As String)
+    Dim Profile As String
+    Dim t As Template
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+
+    On Error GoTo Handler
+
+    Profile = GetSetting("Verbatim", "QuickCards", "QuickCardsProfile", "Verbatim1")
+    If Not Profile Like "Verbatim*" Then Profile = "Verbatim1"
+
+    Set t = ActiveDocument.AttachedTemplate
+
+    For i = 1 To t.BuildingBlockTypes.Count
+        If t.BuildingBlockTypes.Item(i).Name = "Custom 1" Then
+            For j = 1 To t.BuildingBlockTypes.Item(i).Categories.Count
+                If t.BuildingBlockTypes.Item(i).Categories.Item(j).Name = Profile Then
+                    For k = 1 To t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Count
+                        If LCase$(t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Name) = LCase$(QuickCardName) Then
+                            t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Insert Selection.Range, True
+                        End If
+                    Next k
+                End If
+            Next j
+        End If
+    Next i
+
+    Set t = Nothing
+    Exit Sub
+
+Handler:
+    Set t = Nothing
+    MsgBox "Error " & Err.Number & ": " & Err.Description
+End Sub
+
+Public Sub DeleteQuickCard(Optional ByRef QuickCardName As String)
+    Dim Profile As String
+    Dim t As Template
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+
+    On Error GoTo Handler
+
+    If QuickCardName <> "" Or IsNull(QuickCardName) Then
+        If MsgBox("Are you sure you want to delete the Quick Card """ & QuickCardName & """? This cannot be reversed.", vbYesNo, "Are you sure?") = vbNo Then Exit Sub
+    Else
+        If MsgBox("Are you sure you want to delete all saved Quick Cards? This cannot be reversed.", vbYesNo, "Are you sure?") = vbNo Then Exit Sub
+    End If
+
+    Profile = GetSetting("Verbatim", "QuickCards", "QuickCardsProfile", "Verbatim1")
+    If Not Profile Like "Verbatim*" Then Profile = "Verbatim1"
+
+    Set t = ActiveDocument.AttachedTemplate
+
+    ' Delete all building blocks in the Custom 1/Verbatim category
+    For i = 1 To t.BuildingBlockTypes.Count
+        If t.BuildingBlockTypes.Item(i).Name = "Custom 1" Then
+            For j = 1 To t.BuildingBlockTypes.Item(i).Categories.Count
+                If t.BuildingBlockTypes.Item(i).Categories.Item(j).Name = Profile Then
+                    For k = t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Count To 1 Step -1
+                        ' If name provided, delete just that building block, otherwise delete everything in the category
+                        If QuickCardName <> "" Or IsNull(QuickCardName) Then
+                            If t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Name = QuickCardName Then
+                                t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Delete
+                            End If
+                        Else
+                            t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Delete
+                        End If
+                    Next k
+                End If
+            Next j
+        End If
+    Next i
+
+    t.Save
+    Set t = Nothing
+
+    Exit Sub
+
+Handler:
+    Set t = Nothing
+    MsgBox "Error " & Err.Number & ": " & Err.Description
+End Sub
+
+'@Ignore ParameterNotUsed, ProcedureNotUsed
+'@Ignore ProcedureCanBeWrittenAsFunction
+Public Sub GetQuickCardsContent(ByVal c As IRibbonControl, ByRef returnedVal As Variant)
+' Get content for dynamic menu for Quick Cards
+    Dim Profile As String
+    Dim t As Template
+    Dim i As Long
+    Dim j As Long
+    Dim k As Long
+    Dim xml As String
+    Dim QuickCardName As String
+    Dim DisplayName As String
+
+    On Error Resume Next
+
+    Profile = GetSetting("Verbatim", "QuickCards", "QuickCardsProfile", "Verbatim1")
+    If Not Profile Like "Verbatim*" Then Profile = "Verbatim1"
+
+    Set t = ActiveDocument.AttachedTemplate
+
+    ' Start the menu
+    xml = "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"
+
+    ' Populate the list of current Quick Cards in the Custom 1 / Verbatim gallery
+    For i = 1 To t.BuildingBlockTypes.Count
+        If t.BuildingBlockTypes.Item(i).Name = "Custom 1" Then
+            For j = 1 To t.BuildingBlockTypes.Item(i).Categories.Count
+                If t.BuildingBlockTypes.Item(i).Categories.Item(j).Name = Profile Then
+                    For k = 1 To t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Count
+                         QuickCardName = t.BuildingBlockTypes.Item(i).Categories.Item(j).BuildingBlocks.Item(k).Name
+                         DisplayName = Strings.OnlySafeChars(QuickCardName)
+                        xml = xml & "<button id=""QuickCard" & Replace(DisplayName, " ", "") & """ label=""" & DisplayName & """ tag=""" & QuickCardName & """ onAction=""QuickCards.InsertQuickCardFromRibbon"" imageMso=""AutoSummaryResummarize"" />"
+                    Next k
+                End If
+            Next j
+        End If
+    Next i
+
+    ' Close the menu
+    xml = xml & "<button id=""QuickCardSettings"" label=""Quick Card Settings"" onAction=""Ribbon.RibbonMain"" imageMso=""AddInManager""" & " />"
+    xml = xml & "</menu>"
+
+    Set t = Nothing
+
+    returnedVal = xml
+
+    On Error GoTo 0
+
+    Exit Sub
+End Sub
+
+'@Ignore ProcedureNotUsed
+Public Sub InsertQuickCardFromRibbon(ByVal c As IRibbonControl)
+    QuickCards.InsertQuickCard c.Tag
+End Sub