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.
UserForm (.frm file) *Don't Left Click. Right-Click and Save-AS.
UserForm (.frx file) *Don't Left Click. Right-Click and Save-AS.
