Online Trick: Visual Basic

Showing posts with label Visual Basic. Show all posts

Sunday, September 20, 2015

Species Recording Form

When recording species abundance data you often have endless rows with species names and one gets swollen eyes from searching the right line for each data-entry. Therefore I made myself a handy xls-file to collect species abundance data.

In it a VBA-macro is called with a keybord short-cut which matches a species short name you type in the active cell and jumps to the line with that species, the search entry is deleted automatically and you are in the cell where you want to add data... (download).

Fast Correction of Typos in MS Word with VBA

..I use a macro to quickly fix misspelled words. More precisely, the misspelled word is replaced by the first suggestion from the spelling checker. The macro is called by hitting "strg+q" just after a typo occurred.

Download-Instructions:
To use this macro you need to download this word template and save it to your default Microsoft Office Startup folder (or wherever you store your customized templates, the path can be found in word in tools / options / save tab). If stored at the right place the keyboard shortcut macro should work whenever you open a Word file on this computer.

Code:

Sub FirstSugg()

'Author: Kay Cichini
'Date: 2012-01-17
'Info: The template was created with ms word 2003

Dim r As Range
Selection.MoveLeft Unit:=wdWord
Set r = Selection.GoToNext(wdGoToSpellingError)

With r.GetSpellingSuggestions()
  If .Count > 0 Then
    r.Text = .Item(1).Name
  Else: MsgBox ("Lacking Suggestion!")
  End If
End With

Selection.MoveRight Unit:=wdWord
End Sub

Search Google Definition for Words in an Excel-File Using VBA

I have a glossary of words held in an excel-workbook. For getting instant definitions from Google I wrote a small macro which does this for me with one click.

This is how it is done:

1. Insert a command-button from the control toolbox (view / toolbars / control toolbox)
2. Double cllick the command button & within the Visual Basic editor insert the below code.

'Info: Macro that searches Google for a definition
'for the word in the active cell.

'Usage: With mouse select cell with word to be
'defined/searched, then hit the button.

Private Sub CommandButton1_Click()

    Dim mystr As String

    mystring = ActiveCell.Value

    mylink = "http://www.google.at/search?q=define%3A+" & mystring

    ThisWorkbook.FollowHyperlink (mylink)

End Sub

3. In design mode add captation, re-size, place, format your button, etc.
4. Exit design mode.
5. Your finished..

ps: you could also do this using the xls-function Hyperlink() but as you may have noticed, saving xls-files containing this function causes some trouble (warning messages, large storage..)

Match Words in MS-Word File with Words in another File and Apply New Format Using VBA

I present a macro that I wrote for re-formatting scientific species names (it is common to use italic fonts for that) in a Word file. Therefore I used a database of central European species names - this is compared with the words in my file and matches are re-formatted...

(download template)

Note: If you download the template you will need to use your own database and change the path in the script... Else you may contact me for the text-file with species names...

For your own word list: use a tab-delimited txt-file with unique strings without capitalization, like:

yourtextfile.txt:
-------------------------------
one
two
three
...
-------------------------------

Code:

'macro name: ReformatListMatches
'purpose: compares words from document with words from file
'author: kay cichini
'date: 2012-01-04
'licence: cc by-nc-sa

'specifications:
'before running the macro, add a commandbar called "mycombar" and assign the macro "ReformatListMatches" to it,
'run line 8 one time, then disable it, then save file to a template (.dot) and store it at your templates' folder.
'if you don't want a command bar, just skip the above part and don't run line 8!

Sub ReformatListMatches()

'CommandBars("mycombar").Controls(1).TooltipText = "calls procedure that re-formats words that match word list"
'this sets tooltip info, run this only once (!!), otherwise you will be asked to save changes to the dot file
'everytime you close a word doc.

time_start = Timer()

If MsgBox("Re-format matches?" & vbLf & " " & vbLf & "..may take some time" & vbLf & "..be patient! (the active window will be temporarily invisible to speed up process)", vbOKCancel + vbQuestion, "SpKursiv") = vbOK Then
 
Dim vntArrWords As Variant
Dim lngI As Long
Dim strText As String
Dim strPathFile As String
Dim lngFN As Long
 
strPathFile = "C:\LogoXP\SP_words_tab.txt"
'the database with names to compare
 
lngFN = FreeFile
Open strPathFile For Binary As lngFN
 strText = Space(LOF(lngFN))
 Get lngFN, 1, strText
Close lngFN
 
System.Cursor = wdCursorWait
 
vntArrWords = Split(strText, vbCrLf, -1, 1)

ActiveWindow.Visible = False

With ActiveDocument.Content.Find
  .ClearFormatting
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Replacement.ClearFormatting
  .Replacement.Text = "^&"               'replaces match with the original string (but with new format!)
  .Replacement.Font.Italic = True        'here i determine the new format
  For lngI = 0 To UBound(vntArrWords)
    .Text = Trim(vntArrWords(lngI))
    .Execute Replace:=wdReplaceAll
  Next
End With

ActiveWindow.Visible = True

time_end = Timer()

MsgBox "finished!" & vbLf & "(calculation time (mm:ss) = " & time_end - time_start & ")"

Else: Exit Sub
End If

End Sub

BTW: just found a similar tutorial at http://www.garyradley.com/vbatutor/tut4.htm