Programming

 

The vast majority of the programming I'm familiar with revolves around VBA. In college I used some Matlab and I've even spent a bit of time toying around with C# and Powershell, but as a Chemical Engineer, VBA generates profitable results in reasonable time frames.

The following programs (mostly Excel macros) have come in handy in different circumstances.

Many examples may not use the most elegant methods to achieve the goal, but over time style and knowledge will improve.

List Folders:

Generate a simple list of folders within a directory

Sub List_Folders()

 

    'Required References: Microsoft Scripting Runtime

    Dim FSO                 As Scripting.FileSystemObject

    Dim Reference_Folder    As Scripting.Folder

    Dim SubFolder           As Scripting.Folder

 

    Set FSO = New Scripting.FileSystemObject

    Set Reference_Folder = FSO.GetFolder(InputBox("Folder Path:"))

 

    'Only necessary if the macro is executed from a different sheet than where the data

    'should be displayed

    Sheets("Folder List").Select

 

    For Each SubFolder In Reference_Folder.SubFolders

        ActiveCell.Value = SubFolder.Name

        ActiveCell.Offset(1, 0).Select

    Next SubFolder

 

End Sub

On-Click (Right and Left), Execute Sequence:

Sometimes it's more convenient to just bind a specific set of actions to the right and left mouse buttons, rather than having to use the keyboard shortcuts over and over.  Included are separate macros to enable/disable macros to be able to use normal mouse button function without going insane.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Left-Click Action

    'Target = "" 'Format(Date, "dd-mmm-yy")

    Target.Interior.ColorIndex = 14

    'Columns("a:z").AutoFit

End Sub

 

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    'Right-Click Action

    'Target = Format(Date, "dd-mmm-yy")

    Target.Interior.ColorIndex = 16

    Cancel = True

End Sub

 

Sub Hold_Macros()

    'Disable Macros

    Application.EnableEvents = False

End Sub

 

Sub Enable_Macros()

    'Enable Macros

    Application.EnableEvents = True

End Sub

'Devan Munn
'4/28/17

 

Private Sub UserForm_Initialize()
    OptionButton_BW.Value = False
    OptionButton_Color.Value = True
    OptionButton_All.Value = False
    OptionButton_Sel.Value = True
    OptionButton_Cur.Value = False
    CheckBox_Foot.Value = False
    CheckBox_Save.Value = False
    Label_Printer.Caption = Application.ActivePrinter
    Label_PDF_Printer.Caption = "Microsoft XPS Document Writer on Ne01:"
    TextBox_Loc.Value = Environ("USERPROFILE") & "\My Documents\PDF Temp"
End Sub

Private Sub CommandButton_Cancel_Click()
    Unload Me
End Sub

Private Sub CommandButton_PDF_Click()
    Dim shtName         As String
    Dim n               As Integer
    Dim i               As Integer
    Dim j               As Integer
    Dim SheetArray()    As Variant
    Dim WS              As Object
    Dim temp            As String
    Dim PDF_Name        As String

    On Error Resume Next

    Application.ActivePrinter = Label_PDF_Printer.Caption

 

    'Store the current sheet name, to return after execution

    shtName = ActiveSheet.Name
    PDF_Name = TextBox_Loc.Value & "\" & ActiveWorkbook.Name & " " & _
    Format(Now(), "hms") & ".pdf"

    If CheckBox_Save.Value = True Then
        ActiveWorkbook.Save
    End If

    'If the Temporary PDF directory doesn't exist, then creat it

    If Dir(TextBox_Loc.Value, vbDirectory) = Empty Then
        MkDir (TextBox_Loc.Value)
    End If

    n = 1
    j = 0

    'Print all visible worksheets

    If OptionButton_All.Value = True Then
        For i = 1 To ActiveWorkbook.Sheets.Count
            If Sheets(i).Visible = True And IsEmpty(Sheets(i).UsedRange) = False Then
                ReDim Preserve SheetArray(j)
                SheetArray(j) = i
                j = j + 1
            End If
        Next i
        Sheets(SheetArray).Select

        For Each WS In ActiveWindow.SelectedSheets
            With WS.PageSetup
                .PaperSize = xlPaperLetter
                .BlackAndWhite = OptionButton_BW.Value
                .FitToPagesWide = 1
                .Zoom = False
            End With
            If CheckBox_Foot.Value = True Then
                With WS.PageSetup
                    .LeftFooter = ActiveWorkbook.FullName
                    .FooterMargin = Application.InchesToPoints(0)
                End With
            End If
        Next WS

        Sheets(SheetArray).Select
        'TextBox_Loc.Value & "\" & ActiveWorkbook.Name & ".pdf"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_Name, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    'Print only the current worksheet

    ElseIf OptionButton_Cur.Value = True Then
        Sheets(ActiveSheet.Name).Select
        With ActiveSheet.PageSetup
            .PaperSize = xlPaperLetter
            .BlackAndWhite = OptionButton_BW.Value
            .FitToPagesWide = 1
            .Zoom = False
        End With
        If CheckBox_Foot.Value = True Then
            With ActiveSheet.PageSetup
                .LeftFooter = ActiveWorkbook.FullName
                .FooterMargin = Application.InchesToPoints(0)
            End With
        End If
               
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_Name, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True

    'Print all selected worksheets

    ElseIf OptionButton_Sel.Value = True Then
        For Each WS In ActiveWindow.SelectedSheets
            With WS.PageSetup
                .PaperSize = xlPaperLetter
                .BlackAndWhite = OptionButton_BW.Value
                .FitToPagesWide = 1
                .Zoom = False
            End With
            If CheckBox_Foot.Value = True Then
                With WS.PageSetup
                    .LeftFooter = ActiveWorkbook.FullName
                    .FooterMargin = Application.InchesToPoints(0)
                End With
            End If
        Next WS
       
        For Each WS In ActiveWindow.SelectedSheets
            WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_Name, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True
            Exit For
        Next WS
    End If

    If CheckBox_Foot.Value = True Then
        Call Remove_HeaderFooter
    End If


    Sheets(shtName).Select
    Application.ActivePrinter = Label_Printer.Caption
   
    Unload Me
       
End Sub

Private Sub Remove_HeaderFooter()

    'http://www.ozgrid.com/forum/showthread.php?t=165794

    Dim WS As Object
    
    Application.ScreenUpdating = False
    For Each WS In ActiveWindow.SelectedSheets
        With WS.PageSetup
            .CenterFooter = ""
            .LeftFooter = ""
            .RightFooter = ""
        End With
    Next WS
    Application.ScreenUpdating = True
End Sub

Export to PDF (PDF Printer as a UserForm):

It is possible to use the Save-As function in Excel to export a worksheet as a PDF, but it can be tedious if you're only doing it so that you can merge the pages with another document. This tool streamlines it and creates a file with the same name as the Excel file and dumps it into a new "Temp" folder so you can manipulate it and move on.

 

VBA Code (.txt file)

UserForm (.frm file) *Don't Left Click. Right-Click and Save-AS.

UserForm (.frx file) *Don't Left Click. Right-Click and Save-AS.

© 2017 The Biggs Hoson

admin@thebiggshoson.com