diff --git a/1_InvokeUF.txt b/1_InvokeUF.txt new file mode 100644 index 0000000..d7db8fd --- /dev/null +++ b/1_InvokeUF.txt @@ -0,0 +1,22 @@ +' ================================================================================================== +' Purpose of this code is to invoke the User Form when user double click the line on the spreadsheet +' ================================================================================================== + +Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) + +' Define variables needed +Dim iRow As Integer +' Initialize variables +iRow = Target.Row + +' Update Inputs in the form +UpdateInputs iRow + +' Cancel = false means form can not be modified together with cell +Cancel = True + +'possible to modify cell when the form is up +MyCarCheckListForm.Show False + +End Sub + diff --git a/2_InvokeUF_R.txt b/2_InvokeUF_R.txt new file mode 100644 index 0000000..bd761df --- /dev/null +++ b/2_InvokeUF_R.txt @@ -0,0 +1,25 @@ +Option Explicit + +' ================================================================================================== +' Purpose of this code is to invoke the User Form when user double click the line on the spreadsheet +' *** Insert this code to every sheet object from which user form need to be invoked +' ================================================================================================== + +Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) + +' Define variables needed +Dim iRow As Integer +' Initialize variables +iRow = Target.Row + +' Update Inputs in the form +UpdateInputsR iRow ' CASE STUDY 2 + +' Cancel = false means form can not be modified together with cell +Cancel = True + +'possible to modify cell when the form is up +MyCarCheckListFormR.Show False ' CASE STUDY 2 + +End Sub + diff --git a/CheckList_Chapter4.xlsm b/CheckList_Chapter4.xlsm new file mode 100644 index 0000000..0758627 Binary files /dev/null and b/CheckList_Chapter4.xlsm differ diff --git a/Functions.bas b/Functions.bas new file mode 100644 index 0000000..fd9a81b --- /dev/null +++ b/Functions.bas @@ -0,0 +1,114 @@ +Attribute VB_Name = "Functions" + ' (C) 2017 VZ Home Experiments Vladimir Zhbanko //vz.home.experiments@gmail.com + ' VBA code to make work with Excel User Forms easier + ' More time to spend on more interesting stuff. + +'======================================== +' FUNCTION that keep First available Capital letter in the string +'======================================== +Function getFirstCapitalLetter(myInput As String) As String + ' Declaring variables + Dim myResult As String ' This is the return string + Dim i As Long ' Counter for character position + + ' Initialise return string to empty + myResult = "" + + ' For every character in input string, copy digits to + ' return string if they are passing criteria + For i = 1 To Len(myInput) + If Mid(myInput, i, 1) >= "A" And Mid(myInput, i, 1) <= "Z" Then + myResult = myResult + Mid(myInput, i, 1) + Exit For + End If + Next + + ' Then return the return string. ' + getFirstCapitalLetter = myResult +End Function + +'======================================== +' FUNCTION that keep All available Capital letters in the string +'======================================== +Function getAllCapitalLetters(myInput As String) As String + ' Declaring variables + Dim myResult As String ' This is the return string + Dim i As Long ' Counter for character position + + ' Initialise return string to empty + myResult = "" + + ' For every character in input string, copy digits to + ' return string if they are passing criteria + For i = 1 To Len(myInput) + If Mid(myInput, i, 1) >= "A" And Mid(myInput, i, 1) <= "Z" Then + myResult = myResult + Mid(myInput, i, 1) + End If + Next + + ' Then return the return string. ' + getAllCapitalLetters = myResult +End Function +'======================================== +' FUNCTION that removes all text from string, and leave only numbers +'======================================== +Function getOnlyDigit(myInput As String) As String + ' Declaring variables + Dim myResult As String ' This is the return string + Dim i As Long ' Counter for character position + + ' Initialise return string to empty + myResult = "" + + ' For every character in input string, copy digit to + ' return string if they are passing criteria + For i = 1 To Len(myInput) + If Mid(myInput, i, 1) >= "0" And Mid(myInput, i, 1) <= "9" Then + myResult = myResult + Mid(myInput, i, 1) + Exit For + End If + Next + + ' Then return the return string. ' + getOnlyDigit = myResult +End Function +'======================================== +' FUNCTION that tells if string contains digits +'======================================== +' function is adapted using function getOnlyDigits +Function isDigit(myInput As String) As Boolean + ' Variables needed (remember to use "option explicit") + Dim myResult As Boolean ' This is the return boolean + Dim i As Integer ' Counter for character position + + ' Initialise return result to be false + myResult = False + + ' For every character in input string, check if there are + ' numbers. Stop if found at least one number + For i = 1 To Len(myInput) + If Mid(myInput, i, 1) >= "0" And Mid(myInput, i, 1) <= "9" Then + myResult = True + Exit For + Else + myResult = False + End If + Next + + ' Then return the results + isDigit = myResult +End Function +'======================================== +' FUNCTION that count cell color in a range +'======================================== +' This is a user defined function! UDF! +Function CountCellColor(range_data As Range, criteria As Range) As Long + Dim datax As Range + Dim xcolor As Long +xcolor = criteria.Interior.ColorIndex +For Each datax In range_data + If datax.Interior.ColorIndex = xcolor Then + CountCcolor = CountCcolor + 1 + End If +Next datax +End Function diff --git a/MyCarCheckListForm.frm b/MyCarCheckListForm.frm new file mode 100644 index 0000000..30dc864 --- /dev/null +++ b/MyCarCheckListForm.frm @@ -0,0 +1,214 @@ +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} MyCarCheckListForm + Caption = "User Form for Car Evaluation" + ClientHeight = 8520 + ClientLeft = 45 + ClientTop = 375 + ClientWidth = 10515 + OleObjectBlob = "MyCarCheckListForm.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "MyCarCheckListForm" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + + ' (C) 2017 VZ Home Experiments Vladimir Zhbanko //vz.home.experiments@gmail.com + ' VBA code to make work with Excel User Forms easier + ' More time to spend on more interesting stuff. +' ======================================================================================================= +' declaring global variables for cross using in the other functions +' ======================================================================================================= +Public Fail As String ' 2 types Yes/No +Public picPath As String ' string is containing the path to the picture file +Public lRow As Long ' variable to pass row information +' ======================================================================================================= +' this button closes the form +' ======================================================================================================= +Private Sub buttonCancel_Click() +Unload Me +End Sub +' ======================================================================================================= +' information about the program shown by clicking on the button "I am inspired" +' ======================================================================================================= +Private Sub buttonHelp_Click() +MsgBox "User Form for Car Evaluation" & vbCrLf & "(C) 2017 VZ Home Experiments vz.home.experiments@gmail.com", vbOKOnly + vbInformation, "I am inspired!" +End Sub +' ======================================================================================================= +' add Spin Buttons control +' ======================================================================================================= +Private Sub SpinButton1_SpinUp() +If Me.tboxRow.Value <= 2 Then + Exit Sub +End If +Worksheets(Me.tboxSheet.Text).Activate +UpdateInputs Me.tboxRow.Value - 1 +End Sub +Private Sub SpinButton1_SpinDown() +Worksheets(Me.tboxSheet.Text).Activate +UpdateInputs Me.tboxRow.Value + 1 +End Sub + +' ======================================================================================================= +' first form initialization bringing default values +' ======================================================================================================= +Private Sub UserForm_Initialize() +' Not used; code below will be executed on form initialization + +End Sub +' ======================================================================================================= +' User Dialogue "Import Picture" +' ======================================================================================================= +' this portion should point to the picture to enter to the userform +' user select picture browsing to the file and picture is grabbed inside the form +' path to the picture will be stored into Public variable so +' user will continue to write issue description and upon submitting picture is placed to the cell... +' Button "Insert Picture" +Private Sub buttonPicture_Click() + +' File dialog to load picture into the form +With Application.FileDialog(msoFileDialogFilePicker) + .AllowMultiSelect = False + .ButtonName = "Submit" + .Title = "Select an image file" + .Filters.Add "Image", "*.gif; *.jpg; *.jpeg", 1 + + If .Show = -1 Then + 'file has been selected + picPath = .SelectedItems(1) ' this will save path to the picture! + + 'display preview image in image control + Me.imageReport.PictureSizeMode = fmPictureSizeModeZoom + Me.imageReport.Picture = LoadPicture(picPath) + + Else + ' executed when nothing was selected + + End If +End With + +' picture is now in the image box +' path of the picture picPath is saved into Global variable + +End Sub +' ======================================================================================================= +' Copy to the Report page +' ======================================================================================================= +' This code will copy form data from UserForm to the Report page +' Also required to paste comment and score to the reference page if it was changed +' Report page should increase it's size by one row automatically +Private Sub buttonSubmit_Click() + +Dim i As Integer: Dim lRow As Long: Dim lCol As Long: Dim nextRowValue As String +Dim wshDest As Worksheet: Set wshDest = Worksheets("Report") +Dim wshSource As Worksheet: Set wshSource = Worksheets(Me.tboxSheet.Text) + + ' ======================================= + ' code below will check position of radio buttons + ' ======================================= + If (Me.optionYes.Value = True) Then + Fail = "Yes" + End If + + If (Me.optionNo.Value = True) Then + Fail = "No" + End If + + ' Adding protection against incomplete entry - Case Study 1 + If (Me.optionYes.Value = False) And (Me.optionNo.Value = False) Then + Me.optionNo.SetFocus + MsgBox "Check must either pass or fail, please choose at least one option" + Exit Sub + End If + + ' ======================================= + ' This portion refreshes the comment and the score on the source sheet + ' ======================================= + ' refreshing data on the source sheet + ' define the source sheet + ' write the comment and score to the source sheet (it might be changed) + wshSource.Cells(Me.tboxRow.Value, 6) = Fail 'score + wshSource.Cells(Me.tboxRow.Value, 7) = Me.tboxComments.Value 'comment + + ' ======================================= + ' below portion will handle updating the Action page from the UserForm + ' ======================================= + ' only if cboxNeedAction is true + If Me.cboxNeedAction.Value = False Then + ' exit sub if action is not needed + MsgBox "Comment and Score are updated, No Action is created", vbOKOnly + vbInformation, "Source sheet is refreshed" + Exit Sub + + Else + ' ======================================= + ' find the next empty row in the destination sheet + ' ======================================= + wshDest.Activate + ' method below will fill the next available empty row + ' lRow will contain the last written row (ready to write) + For i = 1 To 2000 ' There can not be more than a 2000 rows really!? + currentRowValue = Cells(i, 3).Value + nextRowValue = Cells(i + 1, 1).Value ' saving content of the next rows to add rows dynamically + + ' find where is the last available row in the table + If IsEmpty(currentRowValue) Or currentRowValue = "" Then + lRow = i + If isDigit(Cells(i - 1, 1).Value) = False Then ' if the cell is not number it is a header + wshDest.Cells(i, 1).Value = 1 ' place the starting number + Else + wshDest.Cells(i, 1).Value = wshDest.Cells(i - 1, 1).Value + 1 ' place the consecutive number + wshDest.Cells(i + 1, 1).Value = wshDest.Cells(i, 1).Value + 1 ' place the consecutive number + End If + Exit For + End If + + Next + ' ======================================= + ' check for a completness of the form when gaps are identified + ' ======================================= + ' logic behind: If Fail is 'Yes' then Comments and Actions are required! + If (Me.optionYes.Value = True) And (Trim(Me.tboxComments.Value) = "") Then + Me.tboxComments.SetFocus + MsgBox "Please complete the Action and Comment fields of the form as gaps are identified" + Exit Sub + + End If + + ' ======================================= + ' populate the Result sheet + ' ======================================= + wshDest.Cells(lRow, 3).Value = Me.tboxCategory.Value 'Category + wshDest.Cells(lRow, 4).Interior.ColorIndex = Me.tboxKey.Value 'Key color + wshDest.Cells(lRow, 5).Value = Me.tboxComments.Value 'Comments + wshDest.Cells(lRow, 6).Value = Me.tboxAction.Value 'Action + wshDest.Cells(lRow, 7).Value = Me.tboxCost.Value 'Cost + wshDest.Cells(lRow, 8).Value = picPath 'Path of the picture + + ' Clear the data to be able to fill more again - Case Study 1 + Me.tboxComments.Value = "" + Me.tboxAction.Value = "" + Me.tboxCost.Value = "" + Me.cboxNeedAction.Value = False + Me.optionNo = False + Me.optionYes = False + + ' Adding Budget field - Case Study 1 + Call UpdateBudget + + End If + +' ======================================= +' Code will paste picture to the Result sheet +' ======================================= +' exit if there was no picture added + If picPath = "" Then + Exit Sub + Else + ' add picture using function PastePicture (see module Functions) + PastePicture picPath, lRow + End If + +End Sub + +' ======================================================================================================= diff --git a/MyCarCheckListForm.frx b/MyCarCheckListForm.frx new file mode 100644 index 0000000..7756396 Binary files /dev/null and b/MyCarCheckListForm.frx differ diff --git a/MyCarCheckListFormR.frm b/MyCarCheckListFormR.frm new file mode 100644 index 0000000..0a5dcf7 --- /dev/null +++ b/MyCarCheckListFormR.frm @@ -0,0 +1,154 @@ +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} MyCarCheckListFormR + Caption = "User Form for Car Evaluation - Report" + ClientHeight = 8520 + ClientLeft = 45 + ClientTop = 375 + ClientWidth = 10515 + OleObjectBlob = "MyCarCheckListFormR.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "MyCarCheckListFormR" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + + + ' (C) 2017 VZ Home Experiments Vladimir Zhbanko //vz.home.experiments@gmail.com + ' VBA code to make work with Excel User Forms easier + ' More time to spend on more interesting stuff. + + ' =================================== + ' Version history updates information: + ' =================================== + ' version 1: First Commit + ' version 2: For Case Study + +' declaring global variables for cross using in the other functions +Public Fail As String ' 2 types Yes/No +Public picPath As String ' string is containing the path to the picture file +Public lRow As Long ' variable to pass row information +' ======================================================================================================= +' this button closes the form +' ======================================================================================================= +Private Sub buttonCancel_Click() +Unload Me +End Sub +' ======================================================================================================= +' information about the program shown by clicking on the button "I am inspired" +' ======================================================================================================= +Private Sub buttonHelp_Click() +MsgBox "User Form for Car Evaluation" & vbCrLf & "(C) 2017 VZ Home Experiments vz.home.experiments@gmail.com", vbOKOnly + vbInformation, "I am inspired!" +End Sub +' ======================================================================================================= +' user should be able to create powerpoint slide from the selected row +' ======================================================================================================= +Private Sub buttonPPT_Click() +lRow = Me.tboxRow +WorkbooktoPowerPoint lRow +End Sub + +' ======================================================================================================= +' Case Study: Add Spin Buttons control to update UF +' ======================================================================================================= +Private Sub SpinButton1_SpinUp() +If Me.tboxRow.Value <= 2 Then + Exit Sub +End If +UpdateInputsR Me.tboxRow.Value - 1 +End Sub +Private Sub SpinButton1_SpinDown() +UpdateInputsR Me.tboxRow.Value + 1 +End Sub + +' ======================================================================================================= +' first form initialization bringing default values +' ======================================================================================================= +Private Sub UserForm_Initialize() +' CASE STUDY 2: Lock field comment not to be editable +Me.tboxComments.Locked = True + +End Sub +' ======================================================================================================= +' User Dialogue "Import Picture" +' ======================================================================================================= +' this portion should point to the picture to enter to the userform +' user select picture browsing to the file and picture is grabbed inside the form +' path to the picture will be stored into Public variable so +' user will continue to write issue description and upon submitting picture is placed to the cell... +' Button "Insert Picture" +Private Sub buttonPicture_Click() + +' File dialog to load picture into the form +With Application.FileDialog(msoFileDialogFilePicker) + .AllowMultiSelect = False + .ButtonName = "Submit" + .Title = "Select an image file" + .Filters.Add "Image", "*.gif; *.jpg; *.jpeg", 1 + + If .Show = -1 Then + 'file has been selected + picPath = .SelectedItems(1) ' this will save path to the picture! + + 'display preview image in image control + Me.imageReport.PictureSizeMode = fmPictureSizeModeZoom + Me.imageReport.Picture = LoadPicture(picPath) + + Else + 'user aborted the dialog + + End If +End With + +' picture is now in the image box +' path of the picture is saved into Global variable 'picPath' + +End Sub +' ======================================================================================================= +' Copy/Update to the Report page ' CASE STUDY 2 +' ======================================================================================================= +' This code will copy or rewrite form data from UserForm to the Report page +Private Sub buttonSubmit_Click() + +Dim i As Integer: Dim lRow As Long: Dim lCol As Long +Dim wshDest As Worksheet: Set wshDest = Worksheets("Report") + + ' ======================================= + ' below portion will handle updating the Action page from the UserForm + ' ======================================= + + ' find the next empty row in the destination sheet + wshDest.Activate + + ' set specific row in the table that requires the update + lRow = Me.tboxRow.Value + + ' re-populate the Result sheet + wshDest.Cells(lRow, 3).Value = Me.tboxCategory.Value 'Category + wshDest.Cells(lRow, 4).Interior.ColorIndex = Me.tboxKey.Value 'Key color + wshDest.Cells(lRow, 5).Value = Me.tboxComments.Value 'Comments + wshDest.Cells(lRow, 6).Value = Me.tboxAction.Value 'Action + wshDest.Cells(lRow, 7).Value = Me.tboxCost.Value 'Cost + ' Update Picture Path only if picture was selected by user + If Not picPath = "" Then + wshDest.Cells(lRow, 8).Value = picPath 'Path of the picture + End If + ' CASE STUDY 1 - Adding Budget field + Call UpdateBudget + +' ======================================= +' Code will paste picture to the Result sheet (note: picture will be placed on top of previous one :))) +' ======================================= +' exit if there was no picture added + If picPath = "" Then + Exit Sub + Else + ' add picture using function PastePicture (see module Functions) + PastePicture picPath, lRow + End If + +End Sub + + +' ======================================================================================================= diff --git a/MyCarCheckListFormR.frx b/MyCarCheckListFormR.frx new file mode 100644 index 0000000..c9246bb Binary files /dev/null and b/MyCarCheckListFormR.frx differ diff --git a/Programs.bas b/Programs.bas new file mode 100644 index 0000000..f786090 --- /dev/null +++ b/Programs.bas @@ -0,0 +1,259 @@ +Attribute VB_Name = "Programs" +Option Explicit +'======================================== +'PASTE PICTURE TO CELL +'======================================== +' This Sub gets picture path and the row number where to place picture +' as the column and sheet are fixed we will always use them +Sub PastePicture(picPath, iRow) + + ' resize row height first + Worksheets("Report").Rows(iRow).RowHeight = 79 + + With Worksheets("Report").Pictures.Insert(picPath) + + With .ShapeRange + .LockAspectRatio = msoTrue + .Width = 90 'width of the picture + .Height = 75 'height of the picture + End With + ' define where to place the picture in the cell + .Left = Worksheets("Report").Cells(iRow, 2).Left + 2 + .Top = Worksheets("Report").Cells(iRow, 2).Top + 2 + .Placement = 1 + .PrintObject = True + .Name = "Sample" & iRow ' use .Name property to name the picture with known name + + ' optimize RAM usage by keeping the picture in the cell, not linked to folder source + ' using the "known" name we perform operation on the picture + With ActiveSheet.Shapes.Range(Array("Sample" & iRow)).Select + Selection.Cut + Cells(iRow, 2).Select + ActiveSheet.Pictures.Paste.Select + ' method to move the Shape + Selection.ShapeRange.IncrementLeft 2 + Selection.ShapeRange.IncrementTop 2 + Cells(iRow, 2).Select + End With + + End With + +End Sub + +'======================================== +'UPDATE USER FORM INPUTS +'======================================== + +' This Sub update the input information to the User Form +' information is found using 'iRow' argument that represent worksheet row + +Sub UpdateInputs(iRow) + +' Define variables needed +Dim Item As String: Dim Category As String: Dim Key As Integer: Dim Checkpoint As String: Dim Tools As String: Dim Fail As String: Dim Comments As String +Dim SheetName As String + +' Initialize variables +SheetName = ActiveSheet.Name +Item = getOnlyDigit(SheetName) & "-" & getAllCapitalLetters(SheetName) & "-" & Range("A" & iRow) +Category = Range("B" & iRow).Value +Key = Range("C" & iRow).Interior.ColorIndex ' save color property value to Key variable +Checkpoint = Range("D" & iRow).Value +Tools = Range("E" & iRow).Value +Fail = Range("F" & iRow).Value +Comments = Range("G" & iRow).Value + +' Defining page reference as D1.Nr +MyCarCheckListForm.tboxItem.Text = Item +' Store value of iRow to the form +MyCarCheckListForm.tboxRow.Value = iRow +' Store name of Worksheet +MyCarCheckListForm.tboxSheet.Value = SheetName +' Store name of Category +MyCarCheckListForm.tboxCategory.Text = Category +' Store name of Tools +MyCarCheckListForm.tboxTools.Text = Tools +' Copy the Checkpoint for better overview +MyCarCheckListForm.tboxCheckpoint.Text = Checkpoint + +' Returning a Fail Option +If Fail = "Yes" Then +MyCarCheckListForm.optionYes.Value = True +Else +MyCarCheckListForm.optionYes.Value = False ' <- CASE STUDY 2 - Reset for using Up/Down Arrows +End If + +If Fail = "No" Then +MyCarCheckListForm.optionNo.Value = True +Else +MyCarCheckListForm.optionNo.Value = False ' <- CASE STUDY 2 - Reset for using Up/Down Arrows +End If + +' Put color index number to the tboxKey +MyCarCheckListForm.tboxKey.Value = Key +' Put color to the text box +If Key = 3 Then +MyCarCheckListForm.tboxKey.BackColor = vbRed +ElseIf Key = 14 Then +MyCarCheckListForm.tboxKey.BackColor = vbGreen +ElseIf Key = 6 Then +MyCarCheckListForm.tboxKey.BackColor = vbYellow +ElseIf Key = 7 Then +MyCarCheckListForm.tboxKey.BackColor = vbMagenta +End If + +' Defining Issue from the Comment +MyCarCheckListForm.tboxComments.Text = Comments + +' Update Budget Field - Case Study 1 +Call UpdateBudget + +End Sub + +'======================================== +'UPDATE USER FORM Report ' CASE STUDY 2 +'======================================== + +' This Sub update the input information to the User Form Report +' information is found using 'iRow' argument that represent worksheet row +' Goal is to bring all available information from the report page including picture and create powerpoint slide + +Sub UpdateInputsR(iRow) + +' *** --------------------------------------------------------------------------------------- +' Define variables needed +Dim Item As String: Dim Category As String: Dim Key As Integer: Dim Comments As String +Dim SheetName As String: Dim Action As String: Dim Cost As String: Dim picPath As String + +' Initialize variables +SheetName = ActiveSheet.Name +Item = Range("A" & iRow).Value +Category = Range("C" & iRow).Value +Key = Range("D" & iRow).Interior.ColorIndex ' save color property value to Key variable +Comments = Range("E" & iRow).Value +Action = Range("F" & iRow).Value +Cost = Range("G" & iRow).Value +picPath = Range("H" & iRow).Value ' get picture path +' Defining item reference +MyCarCheckListFormR.tboxItem.Text = Item +' Store value of iRow to the form +MyCarCheckListFormR.tboxRow.Value = iRow +' Store name of Category +MyCarCheckListFormR.tboxCategory.Text = Category +' Put color index number to the tboxKey +MyCarCheckListFormR.tboxKey.Value = Key +' Put color to the text box +If Key = 3 Then +MyCarCheckListFormR.tboxKey.BackColor = vbRed +ElseIf Key = 14 Then +MyCarCheckListFormR.tboxKey.BackColor = vbGreen +ElseIf Key = 6 Then +MyCarCheckListFormR.tboxKey.BackColor = vbYellow +ElseIf Key = 7 Then +MyCarCheckListFormR.tboxKey.BackColor = vbMagenta +End If + +' Defining Issue from the Comment +MyCarCheckListFormR.tboxComments.Text = Comments +' Defining Issue from the Comment +MyCarCheckListFormR.tboxAction.Text = Action +' Defining Issue from the Comment +MyCarCheckListFormR.tboxCost.Text = Cost +' Bringing a picture into the image box +MyCarCheckListFormR.imageReport.Picture = LoadPicture(picPath) + +' Update budget Field +Call UpdateBudget + +End Sub + +'======================================== +'UPDATE BUDGET FIELD OF THE USERFORM +'======================================== + +' This Sub update the input information to the User Form +' CASE STUDY 1 - Adding Budget field + +Sub UpdateBudget() + +Dim Budget As Double: Dim SumCost As Double 'Declare variables + +' Initialize them +Budget = Worksheets("Summary").Range("B8").Value +SumCost = Application.WorksheetFunction.Sum(ThisWorkbook.Sheets("Report").Range("G2:G500")) +' Bring info to the field +MyCarCheckListForm.tboxBudget.Value = Budget - SumCost +MyCarCheckListFormR.tboxBudget.Value = Budget - SumCost +' Color red if Budget is below zero +If Budget - SumCost < 0 Then +MyCarCheckListForm.tboxBudget.BackColor = vbRed +MyCarCheckListFormR.tboxBudget.BackColor = vbRed +Else +MyCarCheckListForm.tboxBudget.BackColor = vbGreen +MyCarCheckListFormR.tboxBudget.BackColor = vbGreen +End If + +End Sub + + + +'======================================== +'CREATE POWER POINT SLIDES +'======================================== + +' This Sub creates PowerPoint slide from the given row (iRow) of the Report page +' Important: Go to Tools -> References -> Enable Microsoft PPT Object Library + +Sub WorkbooktoPowerPoint(iRow) + +' Declare variables + 'for PowerPoint slides + Dim PPT As Object: Dim PPTPres As Object: Dim PPTSlide As Object + Dim oPicture As PowerPoint.Shape: Dim tboxAction As PowerPoint.Shape + ' for Excel worksheet + Dim wshSrc As Worksheet: Set wshSrc = Worksheets("Report") + Dim Item As String: Dim Category As String: Dim Key As String: Dim Issue As String: Dim Action As String: Dim Cost As String + Dim picPath As String + +' Open PowerPoint, Add Presentation, Make it visible + Set PPT = CreateObject("PowerPoint.Application") + Set PPTPres = PPT.Presentations.Add + PPT.Visible = True + +' Set the data to variables + Item = wshSrc.Range("A" & iRow).Value + Category = wshSrc.Range("C" & iRow).Value + Issue = wshSrc.Range("E" & iRow).Value + Action = wshSrc.Range("F" & iRow).Value + Cost = wshSrc.Range("G" & iRow).Value + picPath = wshSrc.Range("H" & iRow).Value ' extend this list + +' Add new blank slide and set the title + Set PPTSlide = PPTPres.Slides.Add(Index:=1, Layout:=ppLayoutTitleOnly) + PPTSlide.Select: PPTSlide.Shapes.Title.TextFrame.TextRange.Text = Category & "-" & Issue + +' Paste the picture and adjust its position + Set oPicture = PPTSlide.Shapes.AddPicture(picPath, msoFalse, msoTrue, Left:=100, Top:=150, Width:=400, Height:=300) + +' Add text box for Action + Set tboxAction = PPTSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=500, Top:=150, Width:=400, Height:=250) + + ' Format the text range + With tboxAction.TextFrame.TextRange + .Text = "Action Suggested: " & Action + With .Font + .Size = 24 + .Name = "Arial" + End With + End With + +' Memory Cleanup (Step useful when adding for loop) + PPT.Activate + Set PPTSlide = Nothing + Set PPTPres = Nothing + Set PPT = Nothing + +End Sub + + +