Office VBA Macros You Can Use Today phần 3 ppt

Excel Procedures page 76 Office VBA: Macros You Can Use Today Exl 'Did the user cancel?¶ If TypeName(sReplace) = "Boolean" Then Exit Sub¶ 'Turn off screen updating¶ Application.ScreenUpdating = False¶ 'Loop through the workbooks¶ For Each Book In Workbooks¶ For Each WS In Book.Worksheets¶ WS.Cells.Replace What:=CStr(sFind), _¶ Replacement:=CStr(sReplace), LookAt:=xlPart, _¶ SearchOrder:=xlByRows, MatchCase:=False¶ Next WS¶ Next Book¶ 'Restore screen updating¶ Application.ScreenUpdating = True¶ End Sub¶ Tip: This macro requires no changing of variables because the variables are changed through an input box provided to the user. Converting Data to a Tabular Format With this macro, you can convert data into a format that helps utilize the built- in features of Excel. Example file: E027.xls Figure 30 – Great Data Layout for Data Entry Scenario: Inputting information and analyzing it are two very different things. What could be a good layout for data entry might be a bad one for analyzing data. A survey is a typical example, presented to the participant looking like this: Excel Procedures Office VBA: Macros You Can Use Today page 77 Exl Figure 31 – Great Data Layout for Data Analysis View the Appendix to learn how to store this procedure in a Standard module. Option Explicit¶ ' * * * * *¶ Sub DataToTabular()¶ 'Variable declaration¶ Dim RngOrig As Range¶ Dim RngDest As Range¶ Dim FixedColumnCount As Long¶ Dim VarColumnCount As Long¶ Dim i As Long¶ On Error Resume Next¶ 'Ask for the data¶ Set RngOrig = Application.InputBox( _¶ Prompt:="Select the data to be converted " & _¶ "(Inlcude the headers)", _¶ Title:="Data", Type:=8)¶ 'Destination¶ Set RngDest = Application.InputBox( _¶ Prompt:="Where do you want the data " & _¶ "(Select top left cell only)", _¶ Title:="Destination", Type:=8)¶ Scenario, continued: However, this layout does not allow you to compile and analyze the data efficiently with Excel. This macro converts the previous data into a more useful format that can be analyzed with Excel’s built-in tools. Excel Procedures page 78 Office VBA: Macros You Can Use Today Exl On Error GoTo 0¶ 'Did the user cancel?¶ If RngOrig Is Nothing Or RngDest Is Nothing Then Exit Sub¶ 'Multiple selections in the origin? (can't do that )¶ If RngOrig.Areas.Count > 1 Then¶ MsgBox "Please select only one range and try again", _¶ vbCritical¶ Exit Sub¶ End If¶ 'Use only first cell of RngDest as the destination¶ Set RngDest = RngDest(1)¶ 'Ask for the number of fixed columns (the variable will¶ 'be the difference)¶ FixedColumnCount = CLng(Application.InputBox( _¶ Prompt:="How many columns are fixed ?" & vbCrLf & _¶ "Note that the macro assumes these columns go " & _¶ "from left to right", Title:="Fixed columns", Type:=1))¶ If FixedColumnCount < 1 Then Exit Sub¶ VarColumnCount = RngOrig.Columns.Count - FixedColumnCount¶ 'Turn off screen updating¶ Application.ScreenUpdating = False¶ 'Put the headers¶ ' First, the fixed ones¶ RngDest.Resize(1, _¶ FixedColumnCount).Value = RngOrig(1).Resize(1, _¶ FixedColumnCount).Value¶ ' Next, two generic (Question and Value)¶ RngDest.Offset(0, FixedColumnCount).Resize(1, _¶ 2).Value = Array("Question", "Value")¶ 'Ok, convert the data, loop through the RngOrig range¶ On Error GoTo err_h 'Trap errors¶ For i = 1 To RngOrig.Rows.Count - 1 'Exclude the headers¶ With RngDest.Offset(VarColumnCount * i - VarColumnCount + 1, _¶ 0).Resize(VarColumnCount, FixedColumnCount)¶ 'Place the fixed value, it will be repeated VarColumnCount times¶ .Value = RngOrig.Offset(i).Resize(1, _¶ FixedColumnCount).Value¶ 'Now, for the questions (Data needs to be transposed)¶ .Offset(, FixedColumnCount).Resize(, _¶ 1).Value = Application.Transpose(RngOrig.Offset(0, _¶ FixedColumnCount).Resize(1, VarColumnCount).Value)¶ 'Finally, the values¶ .Offset(, FixedColumnCount + 1).Resize(, _¶ 1).Value = Application.Transpose(RngOrig.Offset(i, _¶ FixedColumnCount).Resize(1, VarColumnCount).Value)¶ End With¶ Next i¶ err_h:¶ If Err.Number <> 0 Then¶ MsgBox "The following error occured: " & vbCrLf & "Error: " _¶ & Err.Number & ", " & Err.Description, vbCritical¶ Excel Procedures Office VBA: Macros You Can Use Today page 79 Exl End If¶ 'Restore screen updating¶ Application.ScreenUpdating = True¶ End Sub¶ AutoNumbering Invoices and Other Workbooks This macro shows how to create an AutoNumber field. It can be used across a network or on a single PC. Example file: E028.xls This sample shows how to AutoNumber workbooks and demonstrates how it can be used on a network where each individual, working from different PCs, gets a different, sequential number each time. View the Appendix to learn how to store this procedure in a Standard module. Option Explicit¶ ' * * * * *¶ Type Template¶ Number As Long¶ DateStamp As Date¶ End Type¶ ' * * * * *¶ Sub Autonumber()¶ 'Variable declaration¶ Dim FilePath As String¶ Dim File As Long¶ Dim Counter As Long¶ Dim Temp As Template¶ Dim NewTemp As Template¶ 'Change the following variables¶ FilePath = "\\Server\apps\Counter.txt"¶ FilePath = "C:\Counter.dat"¶ File = FreeFile()¶ Scenario: When creating a template, such as one that can be used for an invoice or a survey, it is usually required that each workbook to have a unique number or 'key'. Excel Procedures page 80 Office VBA: Macros You Can Use Today Exl Do¶ On Error Resume Next¶ Open FilePath For Binary Lock Read Write As #File¶ Loop Until Err.Number = 0¶ 'Loop through all the records in the file¶ Do While Not EOF(File)¶ 'Get the record¶ Get #File, , Temp¶ 'Is there information in it?¶ If Temp.Number > 0 Then NewTemp = Temp¶ Loop¶ 'Increase the number by one¶ NewTemp.Number = NewTemp.Number + 1¶ 'Save the date¶ NewTemp.DateStamp = Now()¶ 'Return the number to cell B1¶ Range("B1").Value = NewTemp.Number¶ 'Store the number in the text file¶ Put #File, , NewTemp¶ 'Close the file¶ Close #File¶ End Sub¶ ' * * * * *¶ Sub Auto_Open()¶ 'Call the macro when the workbook opens¶ Autonumber¶ End Sub¶ Note: Change the FilePath variable to point to the folder and file in which the counter is to be stored. Comparing Columns Using Various Criteria This example includes code to highlight the entries that appear in one list but not in the other, to highlight the entries that are common to both lists, and to generate a unique list from both. Example file: E029.xls Scenario: Comparing data is one of the most common tasks for which people use Excel. If two files with inventory part numbers are received, you can find out which part numbers are missing from one list, or which part numbers appear in both lists, or create a list that contains all the part numbers without repetition. Excel Procedures Office VBA: Macros You Can Use Today page 81 Exl View the Appendix to learn how to store this procedure in a Standard module. Option Explicit¶ ' * * * * *¶ Sub CompareColumns()¶ 'Variable declaration¶ Dim RngA As Range¶ Dim RngB As Range¶ Dim RngDest As Range¶ Dim WhatToDo As Long¶ 'Continue if error occurs¶ On Error Resume Next¶ Set RngA = Application.InputBox( _¶ Prompt:="Select the first column (Including the header)", _¶ Title:="First column", Type:=8)¶ Set RngB = Application.InputBox( _¶ Prompt:="Select the second column (Including the header)", _¶ Title:="Second column", Type:=8)¶ On Error GoTo 0¶ 'Did the user cancel?¶ If RngA Is Nothing Or RngB Is Nothing Then Exit Sub¶ 'Make sure only one column is in each range¶ Set RngA = RngA.Columns(1)¶ Set RngB = RngB.Columns(1)¶ 'Ask what to do¶ WhatToDo = CLng(Application.InputBox( _¶ Prompt:="- Enter '1' to highlight items that exist in 1 but " & _¶ "not in 2." & vbCrLf & _¶ "- Enter '2' to highlight items that appear in both columns." _¶ & vbCrLf & _¶ "- Enter '3' to extract a list of the unique items.", _¶ Title:="Compare columns", _¶ Type:=1))¶ 'Turn off screen updating¶ Application.ScreenUpdating = False¶ Select Case WhatToDo¶ Case 1¶ 'Highlight in red the ones that are in A but not in B¶ HighlightInANotInB RngA, RngB, RGB(255, 0, 0)¶ Case 2¶ 'Highlight in blue the ones that are in A and are in B too¶ HighlightInAandInB RngA, RngB, RGB(0, 0, 255)¶ Case 3¶ 'Generate a unique list of both, and put it in column¶ 'user inputs¶ 'Continue if error occurs¶ On Error Resume Next¶ 'Restore screen updating for the inputbox¶ Application.ScreenUpdating = True¶ Set RngDest = Application.InputBox( _¶ Excel Procedures page 82 Office VBA: Macros You Can Use Today Exl Prompt:="Select the target cell", Title:="Unique list", _¶ Type:=8)¶ 'Turn off screen updating¶ Application.ScreenUpdating = False¶ If Not RngDest Is Nothing Then¶ 'If Not RngDest Is Nothing is code for "RngDest indicated"¶ UniqueList RngA, RngB, RngDest(1)¶ End If¶ End Select¶ 'Restore screen updating¶ Application.ScreenUpdating = True¶ End Sub¶ ' * * * * *¶ Sub HighlightInAandInB(ByVal Column1 As Range, _¶ ByVal Column2 As Range, Color As Long)¶ 'Variable declaration¶ Dim Cll As Range¶ 'Limit to the used range, to speed it up¶ Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)¶ Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)¶ 'Remove the header¶ Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)¶ Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)¶ 'Loop through the cells¶ For Each Cll In Column1.Cells¶ 'Use the MATCH() function to see if the value is in there¶ If IsNumeric(Application.Match(Cll.Value, Column2, 0)) Then¶ 'It is, so highlight it¶ Cll.Interior.Color = Color¶ 'To delete the cell, use¶ 'Cll.Delete Shift:=xlShiftUp¶ End If¶ Next Cll¶ End Sub¶ ' * * * * *¶ Sub HighlightInANotInB(ByVal Column1 As Range, _¶ ByVal Column2 As Range, Color As Long)¶ 'Variable declaration¶ Dim Cll As Range¶ 'Limit to the used range, to speed it up¶ Set Column1 = Intersect(Column1, Column1.Worksheet.UsedRange)¶ Set Column2 = Intersect(Column2, Column2.Worksheet.UsedRange)¶ 'Remove the header¶ Set Column1 = Column1.Offset(1).Resize(Column1.Rows.Count - 1)¶ Set Column2 = Column2.Offset(1).Resize(Column2.Rows.Count - 1)¶ 'Loop through the cells¶ For Each Cll In Column1.Cells¶ 'Use the MATCH() function to see if the value is in there¶ If IsError(Application.Match(Cll.Value, Column2, 0)) Then¶ 'Is not, so highlight it¶ Cll.Interior.Color = Color¶ Excel Procedures Office VBA: Macros You Can Use Today page 83 Exl 'To delete the cell, use¶ 'Cll.Delete Shift:=xlShiftUp¶ End If¶ Next Cll¶ End Sub¶ ' * * * * *¶ Sub UniqueList(ByVal Column1 As Range, ByVal Column2 As Range, _¶ RngDest As Range)¶ Dim WS As Worksheet¶ 'Use a temporary worksheet to use Advanced Filter on it¶ Set WS = Workbooks.Add(xlWorksheet).Worksheets(1)¶ 'Put the first column¶ WS.Range("A1").Resize(Column1.Rows.Count).Value = Column1.Value¶ 'Put the second column, skip one row, which is¶ 'the heading¶ WS.Range("A1").Offset(Column1.Rows.Count).Resize( _¶ Column2.Rows.Count - 1).Value = Column2.Offset(1).Resize( _¶ Column2.Rows.Count - 1).Value¶ 'Now, use advanced filter and put the results directly in¶ 'the destination range¶ WS.Range("A:A").AdvancedFilter Action:=xlFilterCopy, _¶ CopyToRange:=RngDest, Unique:=True¶ 'Close the temp workbook without saving¶ WS.Parent.Close SaveChanges:=False¶ End Sub¶ Deleting the Contents of Unlocked Cells This macro illustrates how to delete only those cells that do not contain formulas and are unlocked, which means that they are entry cells. Example file: E030.xls Scenario: When using a workbook that has multiple sheets that all contain input (unlocked, so the user can enter data in them) and output cells (locked, so the user can only see the results and cannot change the formula inside them), you often need to clear only the input cells. Suppose you take complaint calls and, using Excel, you fill out a form, print it, and don’t save it because the printed copy is your only required record. Rather than using a template each time, or closing the file without saving, you can now put a command button on a worksheet that, when clicked, erases the data you entered, thus providing you with a new, blank form. Excel Procedures page 84 Office VBA: Macros You Can Use Today Exl View the Appendix to learn how to store this procedure in a Standard module. Option Explicit¶ ' * * * * *¶ Sub ClearUnlockedCells()¶ 'Variable declaration¶ Dim Rng As Range, UnlockedRng As Range, Cll As Range¶ Dim Sht As Worksheet¶ 'Turn off screen updating¶ Application.ScreenUpdating = False¶ 'Loop through all the worksheets in the active workbook¶ For Each Sht In ActiveWorkbook.Worksheets¶ 'Do it if the sheet is protected¶ If Sht.ProtectContents Then¶ On Error Resume Next¶ 'Delete the previous range¶ Set Rng = Nothing¶ Set UnlockedRng = Nothing¶ 'Get the used range in the worksheet¶ Set Rng = Sht.UsedRange¶ 'Are there any?¶ If Not Rng Is Nothing Then¶ 'See which cells are locked¶ For Each Cll In Rng.Cells¶ If Not Cll.HasFormula Then¶ 'check for formula in cell¶ If Not Cll.Locked Then¶ 'check for locked cell¶ If UnlockedRng Is Nothing Then¶ Set UnlockedRng = Cll¶ Else¶ Set UnlockedRng = Union(Cll, UnlockedRng)¶ End If¶ End If¶ End If¶ Next Cll¶ End If¶ 'Clear it if something is there¶ If Not UnlockedRng Is Nothing Then¶ 'Not UnlockedRng Is Nothing is code for "UnlockedRng¶ 'has something in it"¶ UnlockedRng.ClearContents¶ End If¶ End If¶ Next Sht¶ 'Restore screen updating¶ Application.ScreenUpdating = True¶ End Sub¶ Excel Procedures Office VBA: Macros You Can Use Today page 85 Exl Hiding All Standard Toolbars Except Your Own This procedure shows how to hide all the toolbars in Excel, displaying only a customized one, and thus forcing the user to use only those tools. Example file: E031.xls Figure 32 – Dictator Application Scenario: To create a 'dictator application', that is, one that enables the user to use only the tools that the application provides, one of the first steps is to hide all of Excel’s built-in toolbars. Remember to follow the golden rule: If you customize a “dictator application”, restore the user’s application to its original setup when it quits. [...]... chart For example, you may want to create a PowerPoint presentation for each of the sales regions for the company that can be easily grasped by all the people involved (including supervisors) page 88 Example file: E 032 .xls Office VBA: Macros You Can Use Today Excel Procedures Exl Figure 33 – Pivot Chart in Excel Office VBA: Macros You Can Use Today page 89 Excel Procedures Exl Figure 34 – Pivot Chart... text file that can be imported into another application so that application can use the information to some other purpose In almost every case, there is a need to clean, delete, add, or format the information so that it can be used correctly at a later time Example file: E 037 .xls Figure 38 – Text File in Notepad Office VBA: Macros You Can Use Today page 105 Exl Excel Procedures Exl Figure 39 – Text File... macro uses the pivot table in sample E 032 .xls It should also work with a different pivot chart if you change the reference to it in the code and remove the code that creates the average of the field, unless it provides useful information page 92 Office VBA: Macros You Can Use Today Excel Procedures Saving a Backup C o py of a Workbook Using this procedure, you can create a backup of copy of your workbook... Nothing¶ Set oApp = Nothing¶ End Sub¶ Office VBA: Macros You Can Use Today 0¶ Exl yyy")¶ = 3 to activate)¶ page 101 Excel Procedures Printing a UserForm This procedure demonstrates how to print a UserForm with more flexibility than using the PrintForm method Exl Scenario: Printing a UserForm is a good way to store information; for example, you might want to print a UserForm that contains the information... Range("A4:A" & Rows.Count), _¶ 0) + 3, 1).EntireRow.Delete Shift:=xlShiftUp¶ Loop¶ Office VBA: Macros You Can Use Today page 107 Exl Excel Procedures Exl 'Set the headers in Bold¶ Range( "3: 3").Font.Bold = True¶ 'Add a "TOTAL" column in I¶ 'Use the value in B1 that contains the number of records¶ Range("I3").Value = "TOTAL"¶ Range("I4").Resize(Range("B1").Value).FormulaR1C1 = "=RC3*RC4"¶ 'And a Sum of all orders¶... the macro ‘Sample’ The UserForm is only used in the sample to demonstrate how to use the code In the section 'Change this code to modify the print setup', modifying different things like margins, paper orientation, and paper size—in other words, the same settings that you modify to print a Microsoft Word document can be set as desired page 104 Office VBA: Macros You Can Use Today Excel Procedures I... open the text file, clean it, and apply the formatting that is needed Compare your macro code with the code used in the procedure Edit the procedure so that it uses some of the code that was recorded page 108 Office VBA: Macros You Can Use Today Excel Procedures Extra ctin g Numbers from a Text Strin g Using this procedure, you can extract only the numbers (digits from 0 to 9) from a range that contains... Nothing¶ Set wdApp = Nothing¶ 'Done !¶ Office VBA: Macros You Can Use Today page 1 03 Exl Excel Procedures MsgBox "Done !", vbInformation¶ 'Restore screen updating¶ Application.ScreenUpdating = True¶ End Sub¶ Exl The following code should be placed in a UserForm named ‘fmPrint’ The example file has the form with the code already in it To create from scratch, use Insert | UserForm from the menu bar and design... procedures If you are not at all familiar with VBA, we suggest that you try some others first and get comfortable with the code before you attempt to customize this procedure for your own file Otherwise, if you must use this procedure, you may want to get acquainted with the sample file Scenario: Importing a text file is another common task for which Excel is used Almost all applications can create a... to store this procedure in a Standard module Option Explicit¶ ' * * * * *¶ Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _¶ ByVal bScan As Byte, ByVal dwFlags As Long, _¶ ByVal dwExtraInfo As Long)¶ Private Const VK_SNAPSHOT = &H2C¶ page 102 Office VBA: Macros You Can Use Today Excel Procedures ' * * * * *¶ Sub Sample()¶ fmPrint.Show¶ End Sub¶ ' * * * * *¶ Sub PrintForm()¶ 'Variable . Procedures Office VBA: Macros You Can Use Today page 89 Exl Figure 33 – Pivot Chart in Excel Excel Procedures page 90 Office VBA: Macros You Can Use Today Exl Figure 34 – Pivot Chart. provides useful information. Excel Procedures Office VBA: Macros You Can Use Today page 93 Exl Saving a Backup Copy of a Workbook Using this procedure, you can create a backup of copy of your. into a more useful format that can be analyzed with Excel’s built-in tools. Excel Procedures page 78 Office VBA: Macros You Can Use Today Exl On Error GoTo 0¶ 'Did the user cancel?¶