Coding Tips (JavaScript/CSS/VBA/Win32)

Useful code snippets, tips and some Windows applications

VBA Functions

A Word VBA function to format an image to fit a required width.
This function will format all images in the document.
Based on the code from the Tribbs site 
Sub FormatPic()

    Dim iShapeCount As Integer
    Dim iILShapeCount As Integer

   Dim DocThis As Document
    Dim J As Integer

    Set DocThis = ActiveDocument

  Dim origHeight As Integer
    Dim origWidth  As Integer
    Dim scaleHeight As Double

Dim wid As Integer

wid = PixelsToPoints(350) 'reduce the width to 350 pixels


iILShapeCount = DocThis.InlineShapes.Count
If iILShapeCount > 0 Then
  For J = 1 To iILShapeCount
           origWidth = DocThis.InlineShapes(J).Width

           scaleHeight = wid / origWidth

           DocThis.InlineShapes(J).Width = (wid)

           DocThis.InlineShapes(J).Height = 
               DocThis.InlineShapes(J).Height * scaleHeight
       Next J
    End If
End Sub



A VBA function to extract the directory name from a file name.

 
Function GetDirName(selname As String)

Dim selName1 As String
Dim inFoundPos  As Integer

inFoundPos = InStrRev(selname, "\")
selName1 = Mid(selname, 1, inFoundPos)
GetDirName = selName1

End Function

A VBA function to insert a menu item

 

Sub InsertMenu()

Dim oMenuBar As CommandBar
Dim oNewMenu As CommandBarControl
Dim oSaveAsMenu As CommandBarControl
Dim SaveAsPosition As Integer

' Specify the CommandBar to add to. In this example, the New Menu
' item is added to the Word for Windows default File menu.

Set oMenuBar = CommandBars.Item("File")

 ' Find the position for the Save As menu
For I = 1 To oMenuBar.Controls.Count
   If oMenuBar.Controls(I).Caption = "Save &As..." Then
      SaveAsPosition = I
      Exit For
   End If
Next I

' Create a New Menu object and add it to the built-in Menu Bar.
Set oNewMenu = oMenuBar.Controls.Add(msoControlButton, _
   , , SaveAsPosition + 1)

With oNewMenu
   ' Give the menu item some display text.
   .Caption = "&Test"
   ' Specify macro to run when user clicks the menu item.
   .OnAction = "TestSub"
End With

End Sub

A VBA function to delete a menu item

Sub DeleteMenu()
Dim oMenuBar As CommandBar
Dim I As Integer

Set oMenuBar = CommandBars.Item("File")

For I = 1 To oMenuBar.Controls.Count
   If oMenuBar.Controls(I).Caption = "&Test" Then
      oMenuBar.Controls(I).Delete
      Exit For
   End If
Next I
End Sub


Additional Resources:
VBA-Programmer
Lots of code snippets