├── 9781484222041.jpg ├── Ch01 ├── AgeInYears.xlsm ├── AgeInYears_Explicit Declaration.xlsm ├── AgeInYears_Explicit Declaration_PrivateModuleVariables.xlsm ├── AgeInYears_Explicit Declaration_PrivateProcedure.xlsm ├── AgeInYears_Explicit Declaration_Propertyrocedure.xlsm ├── AgeInYears_Explicit Declaration_PublicModuleVariables.xlsm ├── AgeInYears_Implicit Declaration.xlsm ├── AgeInYears_Variable Declaration.xlsm ├── InputBox.xlsm ├── MsgBox.xlsm ├── Reddick Naming Conventions 6.01.pdf └── UserForm.xlsm ├── Ch02 ├── Aplication InputBox Method.xlsm ├── Application Events.xlsm ├── Application GetOpenFileName and GetSaveAsFileName Methods.xlsm ├── Application OnTime Method.xlsm ├── Application SheetChange Event.xlsm ├── Application SheetNameChange Event.xlsm ├── Application.FileDialog Method.xlsm ├── Applicattion Events.xlsm ├── CApplicationEvents.cls └── CSheetNameChange.cls ├── Ch03 ├── Worbook referencing ScreenUpdating.xlsm ├── Worbook referencing.xlsm ├── Worbook_Activate event.xlsm ├── Worbook_Open Event with Application.OnTime method.xlsm ├── Worbook_Open Event with Application.Time method.xlsm ├── Worbook_Open Event with timer Repaint DoEvents.xlsm ├── Worbook_Open Event with timer Repaint.xlsm ├── Worbook_Open Event with timer.xlsm ├── Worbook_Open Event.xlsm ├── Workbook Events with CSheetNameChange Class.xlsm └── Workbook Events.xlsm ├── Ch04 ├── Workbook and Worksheet Events with Me keyword.xlsm ├── Worksheet Events with CSheetNameChange Class.xlsm ├── Worksheet Events.xlsm └── Worksheet Referencing.xlsm ├── Ch05 ├── Names Collection.xlsm └── Range Properties.xlsm ├── Ch06 ├── sr27_NutrientsPer100g.xlsm ├── sr27_NutrientsPer100g_Range.AutoFilter.xlsm ├── sr27_NutrientsPer100g_Range.Find.xlsm ├── sr27_NutrientsPer100g_Range.Sort.xlsm ├── sr27_NutrientsPer100g_Sort Sum of Nutrients.xlsm ├── sr27_NutrientsPer100g_Sort Sum of Nutrients_PasteSpecial.xlsm └── sr27_NutrientsPerFirstCommonMeasure_SearchFoodItems.xlsm ├── Ch07 ├── BMI Companion Chart with data.xlsx ├── BMI Companion Chart.xlsm ├── BMI Companion Chart_Database.xlsm └── USDA Food Composer_Database.xlsm ├── Ch08 ├── BMI Companion Chart_Database.xlsm ├── BMI Companion Chart_DatabaseClass.xlsm ├── BMI Companion Chart_SheetDBEngine.xlsm ├── SheetDBEngine.cls ├── SheetDBEngine.xlsm ├── USDA Food Composer_DatabaseClass.xlsm ├── USDA Food Composer_SheetDBEngine.xlsm ├── clsDatabase.cls ├── frmDBProperties.frm ├── frmDBProperties.frx └── frmDBProperties.xlsm ├── Ch09 ├── USDA Food Composer_SheetDBEngineManageAutomation.xlsm ├── USDA Food Composer_SheetDBEngineManageAutomation1.xlsm ├── USDA Food Composer_SheetDBEngineManageCopyPasteRecords.xlsm ├── USDA Food Composer_SheetDBEnginebasUSDA.xlsm └── USDA Food Composer_SheetDBEnginefrmUSDA.xlsm ├── Ch10 ├── Apple.bmp ├── Caju.bmp ├── CloseButton.bmp ├── Donut.bmp ├── Timer class.xlsm ├── USDA Food Composer_frmAbout.xlsm └── UserForm_APIs.xlsm ├── Ch11 └── USDA Food Composer_RibbonX.xlsm ├── LICENSE.txt ├── README.md └── contributing.md /9781484222041.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/9781484222041.jpg -------------------------------------------------------------------------------- /Ch01/AgeInYears.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Explicit Declaration.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Explicit Declaration.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Explicit Declaration_PrivateModuleVariables.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Explicit Declaration_PrivateModuleVariables.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Explicit Declaration_PrivateProcedure.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Explicit Declaration_PrivateProcedure.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Explicit Declaration_Propertyrocedure.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Explicit Declaration_Propertyrocedure.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Explicit Declaration_PublicModuleVariables.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Explicit Declaration_PublicModuleVariables.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Implicit Declaration.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Implicit Declaration.xlsm -------------------------------------------------------------------------------- /Ch01/AgeInYears_Variable Declaration.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/AgeInYears_Variable Declaration.xlsm -------------------------------------------------------------------------------- /Ch01/InputBox.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/InputBox.xlsm -------------------------------------------------------------------------------- /Ch01/MsgBox.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/MsgBox.xlsm -------------------------------------------------------------------------------- /Ch01/Reddick Naming Conventions 6.01.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/Reddick Naming Conventions 6.01.pdf -------------------------------------------------------------------------------- /Ch01/UserForm.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch01/UserForm.xlsm -------------------------------------------------------------------------------- /Ch02/Aplication InputBox Method.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Aplication InputBox Method.xlsm -------------------------------------------------------------------------------- /Ch02/Application Events.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application Events.xlsm -------------------------------------------------------------------------------- /Ch02/Application GetOpenFileName and GetSaveAsFileName Methods.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application GetOpenFileName and GetSaveAsFileName Methods.xlsm -------------------------------------------------------------------------------- /Ch02/Application OnTime Method.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application OnTime Method.xlsm -------------------------------------------------------------------------------- /Ch02/Application SheetChange Event.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application SheetChange Event.xlsm -------------------------------------------------------------------------------- /Ch02/Application SheetNameChange Event.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application SheetNameChange Event.xlsm -------------------------------------------------------------------------------- /Ch02/Application.FileDialog Method.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Application.FileDialog Method.xlsm -------------------------------------------------------------------------------- /Ch02/Applicattion Events.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch02/Applicattion Events.xlsm -------------------------------------------------------------------------------- /Ch02/CApplicationEvents.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CApplicationEvents" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 12 | Dim WithEvents app As Excel.Application 13 | Attribute app.VB_VarHelpID = -1 14 | 15 | Private Sub Class_Initialize() 16 | Set app = Application 17 | End Sub 18 | 19 | Private Sub Class_Terminate() 20 | Set app = Nothing 21 | End Sub 22 | 23 | Private Sub app_AfterCalculate() 24 | Dim strMsg As String 25 | Dim strTitle As String 26 | 27 | strTitle = "Application AfterCalculate event fired" 28 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 29 | strMsg = strMsg & "Application_AfterCalculate event fired" & vbCrLf 30 | strMsg = strMsg & "One or more workbooks was calculated!" 31 | MsgBox strMsg, vbInformation, strTitle 32 | End Sub 33 | 34 | Private Sub app_NewWorkbook(ByVal Wb As Workbook) 35 | Dim strMsg As String 36 | Dim strTitle As String 37 | 38 | strTitle = "Application NewWorkbook event fired" 39 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 40 | strMsg = strMsg & "Application_NewWorkbook event fired." & vbCrLf 41 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 42 | strMsg = strMsg & "(Excel has opened another workbook!)" 43 | MsgBox strMsg, vbInformation, strTitle 44 | End Sub 45 | 46 | Private Sub app_SheetActivate(ByVal Sh As Object) 47 | Dim strMsg As String 48 | Dim strTitle As String 49 | 50 | strTitle = "Application SheetActivate event fired" 51 | strMsg = strMsg & " Application_SheetActivate event fired" & vbCrLf 52 | strMsg = "CApplicationEvents object" & vbCrLf 53 | strMsg = strMsg & "Applicatrion_SheetActivate event fired" 54 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 55 | strMsg = strMsg & "Sheet activated is " & Sh.Name 56 | MsgBox strMsg, vbInformation, strTitle 57 | End Sub 58 | 59 | Private Sub app_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 60 | Dim strMsg As String 61 | Dim strTitle As String 62 | 63 | strTitle = "Application SheetBeforeDoubleClick event fired" 64 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 65 | strMsg = strMsg & " Application_SheetBeforeDoubleClick event fired." & vbCrLf 66 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 67 | strMsg = strMsg & "Sheet double clicked is: " & Sh.Name & vbCrLf 68 | strMsg = strMsg & "Do you want to double click cell " _ 69 | & Target.Address & " from " & Sh.Name & " and put it on Edit mode?" 70 | If MsgBox(strMsg, vbYesNo + vbQuestion, strTitle) = vbNo Then 71 | Cancel = True 72 | End If 73 | End Sub 74 | 75 | Private Sub app_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 76 | Dim strMsg As String 77 | Dim strTitle As String 78 | 79 | strTitle = "Application SheetBeforeRightClick event fired" 80 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 81 | strMsg = strMsg & "Application_SheetBeforeRightClick event fired" & vbCrLf 82 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 83 | strMsg = strMsg & " Sheet Right Clicked is " & Sh.Name & vbCrLf 84 | strMsg = strMsg & "Do you want to right click cell " _ 85 | & Target.Address & " from " & Sh.Name & " and show the Context Menu?" 86 | If MsgBox(strMsg, vbYesNo + vbQuestion, strTitle) = vbNo Then 87 | Cancel = True 88 | End If 89 | End Sub 90 | 91 | Private Sub app_SheetCalculate(ByVal Sh As Object) 92 | Dim strMsg As String 93 | Dim strTitle As String 94 | 95 | strTitle = "Application SheetCalculate event fired" 96 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 97 | strMsg = strMsg & "Application_SheetCalculate event fired" & vbCrLf 98 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 99 | strMsg = strMsg & "Sheet " & Sh.Name & " was calculated!" 100 | MsgBox strMsg, vbInformation, strTitle 101 | End Sub 102 | 103 | Private Sub app_SheetChange(ByVal Sh As Object, ByVal Target As Range) 104 | Dim strMsg As String 105 | Dim strTitle As String 106 | 107 | strTitle = "Application SheetChange event fired" 108 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 109 | strMsg = strMsg & "Application_SheetChange event fired" & vbCrLf 110 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 111 | strMsg = strMsg & "Sheet changed is " & Sh.Name & vbCrLf 112 | strMsg = strMsg & "Cell(s) changed is(are) " & Target.Address 113 | MsgBox strMsg, vbInformation, strTitle 114 | End Sub 115 | 116 | Private Sub app_SheetDeactivate(ByVal Sh As Object) 117 | Dim strMsg As String 118 | Dim strTitle As String 119 | 120 | strTitle = "Application SheetDeactivate event fired" 121 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 122 | strMsg = strMsg & "Application_SheetDeactivate event fired" & vbCrLf 123 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 124 | strMsg = strMsg & "Sheet Deactivated is " & Sh.Name 125 | MsgBox strMsg, vbInformation, strTitle 126 | End Sub 127 | 128 | Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 129 | Dim strMsg As String 130 | Dim strTitle As String 131 | 132 | strTitle = "Application SheetSelectionChange( event fired" 133 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 134 | strMsg = strMsg & "Application_SheetSelectionChange event fired" & vbCrLf 135 | strMsg = strMsg & "Workbook: " & Sh.Parent.Name & vbCrLf 136 | strMsg = strMsg & "Sheet where selection changed is " & Sh.Name & vbCrLf 137 | strMsg = strMsg & "Cell(s) selected is(are) " & Target.Address 138 | MsgBox strMsg, vbInformation, strTitle 139 | End Sub 140 | 141 | Private Sub app_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window) 142 | Dim strMsg As String 143 | Dim strTitle As String 144 | 145 | strTitle = "Application WindowActivate event fired" 146 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 147 | strMsg = strMsg & "Application_WindowActivate event fired" & vbCrLf 148 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 149 | strMsg = strMsg & "(Excel has more than one workbook opened or the workbook is opening)" 150 | MsgBox strMsg, vbInformation, strTitle 151 | End Sub 152 | 153 | Private Sub app_WindowDeactivate(ByVal Wb As Workbook, ByVal Wn As Window) 154 | Dim strMsg As String 155 | Dim strTitle As String 156 | 157 | strTitle = "Application WindowDeactivate event fired" 158 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 159 | strMsg = strMsg & "Application_WindowDeactivate event fired" & vbCrLf 160 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 161 | strMsg = strMsg & "(Excel has more than one workbook opened or the workbook is closing)" 162 | MsgBox strMsg, vbInformation, strTitle 163 | End Sub 164 | 165 | Private Sub app_WindowResize(ByVal Wb As Workbook, ByVal Wn As Window) 166 | Dim strMsg As String 167 | Dim strTitle As String 168 | 169 | strTitle = "Application WindowResize event fired" 170 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 171 | strMsg = strMsg & "Application_WindowResize event fired" & vbCrLf 172 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 173 | strMsg = strMsg & "(The worbook window had been restored, maximized or resized inside Excel)" 174 | MsgBox strMsg, vbInformation, strTitle 175 | End Sub 176 | 177 | Private Sub app_WorkbookActivate(ByVal Wb As Workbook) 178 | Dim strMsg As String 179 | Dim strTitle As String 180 | 181 | strTitle = "Application WorkbookActivate event fired" 182 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 183 | strMsg = strMsg & "Application_WorkbookActivate event fired." & vbCrLf 184 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 185 | strMsg = strMsg & "(Excel has more than one workbook opened or the workbook is opening!)" 186 | MsgBox strMsg, vbInformation, strTitle 187 | End Sub 188 | 189 | Private Sub app_WorkbookAfterSave(ByVal Wb As Workbook, ByVal Success As Boolean) 190 | Dim strMsg As String 191 | Dim strTitle As String 192 | 193 | strTitle = "Application WorkbookAfterSave event fired" 194 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 195 | strMsg = strMsg & "Application_WorkbookAfterSave event fired" & vbCrLf 196 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 197 | strMsg = strMsg & "The saving process was " & IIf(Success, "successfull", "failed") 198 | MsgBox strMsg, vbInformation, strTitle 199 | End Sub 200 | 201 | Private Sub app_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean) 202 | Dim strMsg As String 203 | Dim strTitle As String 204 | 205 | strTitle = "Application WorkbookBeforeClose event fired" 206 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 207 | strMsg = strMsg & "Application_WorkbookBeforeClose event fired" & vbCrLf 208 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 209 | strMsg = strMsg & "Do you want to close the workbook?" 210 | If MsgBox(strMsg, vbYesNo + vbQuestion, strTitle) = vbNo Then 211 | Cancel = True 212 | End If 213 | End Sub 214 | 215 | Private Sub app_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean) 216 | Dim strMsg As String 217 | Dim strTitle As String 218 | 219 | strTitle = "Application WorkbookBeforePrint event fired" 220 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 221 | strMsg = strMsg & "Application_WorkbookBeforePrint event fired" & vbCrLf 222 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 223 | strMsg = strMsg & "Do you want to print the workbook?" 224 | If MsgBox(strMsg, vbYesNo + vbQuestion, strTitle) = vbNo Then 225 | Cancel = True 226 | End If 227 | End Sub 228 | 229 | Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) 230 | Dim strMsg As String 231 | Dim strTitle As String 232 | 233 | strTitle = "Application WorkbookBeforeSave event fired" 234 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 235 | strMsg = strMsg & "Application_WorkbookBeforeSave event fired" & vbCrLf 236 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 237 | strMsg = strMsg & "Do you want to save the workbook?" 238 | If MsgBox(strMsg, vbYesNo + vbQuestion, strTitle) = vbNo Then 239 | Cancel = True 240 | Else 241 | If SaveAsUI Then 242 | MsgBox "Save As dialog box will now be opened: Folder or Workbook name can be changed!" 243 | End If 244 | End If 245 | End Sub 246 | 247 | Private Sub app_WorkbookDeactivate(ByVal Wb As Workbook) 248 | Dim strMsg As String 249 | Dim strTitle As String 250 | 251 | strTitle = "Application WorkbookDeactivate event fired" 252 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 253 | strMsg = strMsg & "Application_WorkbookDeactivate event fired" & vbCrLf 254 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 255 | strMsg = strMsg & "(Excel has more than one workbook opened or the workbook is closing!)" 256 | MsgBox strMsg, vbInformation, strTitle 257 | End Sub 258 | 259 | Private Sub app_WorkbookNewChart(ByVal Wb As Workbook, ByVal Ch As Chart) 260 | Dim strMsg As String 261 | Dim strTitle As String 262 | 263 | strTitle = "Application WorkbookNewChart event fired" 264 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 265 | strMsg = strMsg & "Application_WorkbookNewChart event fired" & vbCrLf 266 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 267 | strMsg = strMsg & "Chart inserted is" & Ch.Name & vbCrLf 268 | MsgBox strMsg, vbInformation, strTitle 269 | End Sub 270 | 271 | Private Sub app_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object) 272 | Dim strMsg As String 273 | Dim strTitle As String 274 | 275 | strTitle = "Application WorkbookNewSheet event fired" 276 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 277 | strMsg = strMsg & "Application_WorkbookNewSheet event fired" & vbCrLf 278 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 279 | strMsg = strMsg & "Sheet inserted is" & Sh.Name & vbCrLf 280 | MsgBox strMsg, vbInformation, strTitle 281 | End Sub 282 | 283 | Private Sub app_WorkbookOpen(ByVal Wb As Workbook) 284 | Dim strMsg As String 285 | Dim strTitle As String 286 | 287 | strTitle = "Application WorkbookOpen event fired" 288 | strMsg = "CApplicationEvents object" & vbCrLf & vbCrLf 289 | strMsg = strMsg & "Application_WorkbookOpen event fired" & vbCrLf 290 | strMsg = strMsg & "Workbook: " & Wb.Name & vbCrLf 291 | MsgBox strMsg, vbInformation, strTitle 292 | End Sub 293 | 294 | -------------------------------------------------------------------------------- /Ch02/CSheetNameChange.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "CSheetnameChange" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 12 | Event SheetNameChange(ByVal Sh As Object, ByRef Cancel As Boolean) 13 | 14 | Private WithEvents app As Excel.Application 15 | Attribute app.VB_VarHelpID = -1 16 | Private mWks As Worksheet 17 | Private mstrWksName As String 18 | 19 | Private Sub Class_Initialize() 20 | Set app = Application 21 | Set mWks = ActiveSheet 22 | mstrWksName = mWks.Name 23 | End Sub 24 | 25 | Private Sub Class_Terminate() 26 | Set mWks = Nothing 27 | Set app = Nothing 28 | End Sub 29 | 30 | Public Sub NameChange(Optional wks As Worksheet) 31 | Dim bolCancel As Boolean 32 | 33 | If wks Is Nothing Then 34 | Set wks = app.ActiveSheet 35 | End If 36 | 37 | If mstrWksName <> mWks.Name Then 38 | RaiseEvent SheetNameChange(mWks, bolCancel) 39 | If bolCancel Then 40 | mWks.Name = mstrWksName 41 | End If 42 | End If 43 | 44 | Set mWks = wks 45 | mstrWksName = mWks.Name 46 | End Sub 47 | 48 | Private Sub app_SheetActivate(ByVal Sh As Object) 49 | Call NameChange(Sh) 50 | End Sub 51 | 52 | Private Sub app_SheetChange(ByVal Sh As Object, ByVal Target As Range) 53 | Call NameChange(Sh) 54 | End Sub 55 | 56 | Private Sub app_SheetDeactivate(ByVal Sh As Object) 57 | Call NameChange(Sh) 58 | End Sub 59 | 60 | Private Sub app_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 61 | Call NameChange(Sh) 62 | End Sub 63 | 64 | Private Sub app_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean) 65 | Call NameChange 66 | End Sub 67 | -------------------------------------------------------------------------------- /Ch03/Worbook referencing ScreenUpdating.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook referencing ScreenUpdating.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook referencing.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook referencing.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Activate event.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Activate event.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event with Application.OnTime method.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event with Application.OnTime method.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event with Application.Time method.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event with Application.Time method.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event with timer Repaint DoEvents.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event with timer Repaint DoEvents.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event with timer Repaint.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event with timer Repaint.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event with timer.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event with timer.xlsm -------------------------------------------------------------------------------- /Ch03/Worbook_Open Event.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Worbook_Open Event.xlsm -------------------------------------------------------------------------------- /Ch03/Workbook Events with CSheetNameChange Class.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Workbook Events with CSheetNameChange Class.xlsm -------------------------------------------------------------------------------- /Ch03/Workbook Events.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch03/Workbook Events.xlsm -------------------------------------------------------------------------------- /Ch04/Workbook and Worksheet Events with Me keyword.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch04/Workbook and Worksheet Events with Me keyword.xlsm -------------------------------------------------------------------------------- /Ch04/Worksheet Events with CSheetNameChange Class.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch04/Worksheet Events with CSheetNameChange Class.xlsm -------------------------------------------------------------------------------- /Ch04/Worksheet Events.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch04/Worksheet Events.xlsm -------------------------------------------------------------------------------- /Ch04/Worksheet Referencing.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch04/Worksheet Referencing.xlsm -------------------------------------------------------------------------------- /Ch05/Names Collection.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch05/Names Collection.xlsm -------------------------------------------------------------------------------- /Ch05/Range Properties.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch05/Range Properties.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g_Range.AutoFilter.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g_Range.AutoFilter.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g_Range.Find.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g_Range.Find.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g_Range.Sort.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g_Range.Sort.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g_Sort Sum of Nutrients.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g_Sort Sum of Nutrients.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPer100g_Sort Sum of Nutrients_PasteSpecial.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPer100g_Sort Sum of Nutrients_PasteSpecial.xlsm -------------------------------------------------------------------------------- /Ch06/sr27_NutrientsPerFirstCommonMeasure_SearchFoodItems.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch06/sr27_NutrientsPerFirstCommonMeasure_SearchFoodItems.xlsm -------------------------------------------------------------------------------- /Ch07/BMI Companion Chart with data.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch07/BMI Companion Chart with data.xlsx -------------------------------------------------------------------------------- /Ch07/BMI Companion Chart.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch07/BMI Companion Chart.xlsm -------------------------------------------------------------------------------- /Ch07/BMI Companion Chart_Database.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch07/BMI Companion Chart_Database.xlsm -------------------------------------------------------------------------------- /Ch07/USDA Food Composer_Database.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch07/USDA Food Composer_Database.xlsm -------------------------------------------------------------------------------- /Ch08/BMI Companion Chart_Database.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/BMI Companion Chart_Database.xlsm -------------------------------------------------------------------------------- /Ch08/BMI Companion Chart_DatabaseClass.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/BMI Companion Chart_DatabaseClass.xlsm -------------------------------------------------------------------------------- /Ch08/BMI Companion Chart_SheetDBEngine.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/BMI Companion Chart_SheetDBEngine.xlsm -------------------------------------------------------------------------------- /Ch08/SheetDBEngine.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/SheetDBEngine.cls -------------------------------------------------------------------------------- /Ch08/SheetDBEngine.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/SheetDBEngine.xlsm -------------------------------------------------------------------------------- /Ch08/USDA Food Composer_DatabaseClass.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/USDA Food Composer_DatabaseClass.xlsm -------------------------------------------------------------------------------- /Ch08/USDA Food Composer_SheetDBEngine.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/USDA Food Composer_SheetDBEngine.xlsm -------------------------------------------------------------------------------- /Ch08/clsDatabase.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsDatabase" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 12 | Private WithEvents mwb As Workbook 13 | Attribute mwb.VB_VarHelpID = -1 14 | Private WithEvents mws As Worksheet 15 | Attribute mws.VB_VarHelpID = -1 16 | Public Dirty As Boolean 'Indicate if record dat had been changed 17 | Private mstrLastRecord As String 'Retain the name of current record 18 | Private Enum Operation 19 | LoadRecord = 1 20 | SaveRecord = 2 21 | End Enum 22 | 23 | Dim mstrdbDataValidationList As String 24 | Dim mstrdbSavedRecords As String 25 | Dim mstrdbRecordName As String 26 | Dim mstrdbOneSide As String 27 | Dim mintdbOneSideColumsCount As Integer 28 | Dim mstrdbManySide1 As String 29 | Dim mstrdbManySide2 As String 30 | Dim mstrdbManySide3 As String 31 | Dim mstrdbManySide4 As String 32 | Dim mstrdbManySidePrefix As String 33 | Dim mintdbManySideColumnsCount As Integer 34 | Dim mintdbManySideRowsCount As Integer 35 | Dim mintdbRecordsFirstRow As Integer 36 | Dim mstrdbManySideFirstColumn As String 37 | Dim mintdbRangeOffset As Integer 38 | 39 | Private Sub Class_Initialize() 40 | Set mwb = ThisWorkbook 41 | Set mws = ActiveSheet 42 | mstrdbDataValidationList = mws.Range("dbDataValidationList") 43 | mstrdbSavedRecords = mws.Range("dbSavedRecords") 44 | mstrdbRecordName = mws.Range("dbRecordName") 45 | mstrdbOneSide = mws.Range("dbOneSide") 46 | mintdbOneSideColumsCount = mws.Range("dbOneSideColumsCount") 47 | mstrdbManySide1 = mws.Range("dbManySide1") 48 | mstrdbManySide2 = mws.Range("dbManySide2") 49 | mstrdbManySide3 = mws.Range("dbManySide3") 50 | mstrdbManySide4 = mws.Range("dbManySide4") 51 | mstrdbManySidePrefix = mws.Range("dbManySidePrefix") 52 | mintdbManySideColumnsCount = mws.Range("dbManySideColumnsCount") 53 | mintdbManySideRowsCount = mws.Range("dbManySideRowsCount ") 54 | mintdbRecordsFirstRow = mws.Range("dbRecordsFirstRow") 55 | mstrdbManySideFirstColumn = mws.Range("dbManySideFirstColumn") 56 | mintdbRangeOffset = mws.Range("dbRangeOffset") 57 | End Sub 58 | 59 | Private Sub mwb_BeforeClose(Cancel As Boolean) 60 | Dim strMsg As String 61 | Dim strTitle As String 62 | Dim strRecord As String 63 | Dim bolSaved As Boolean 64 | 65 | If Me.Dirty Then 66 | strRecord = mws.Range(mstrdbDataValidationList) 67 | If strRecord = "" Then strRecord = "New " & mstrdbRecordName 68 | strTitle = "Save " & strRecord & " data?" 69 | strMsg = strRecord & " data had been changed." & vbCrLf 70 | strMsg = strMsg & "Save " & strRecord & " data before close the workbook?" 71 | Select Case MsgBox(strMsg, vbYesNoCancel + vbQuestion, strTitle) 72 | Case vbYes 73 | bolSaved = Save(strRecord) 74 | Cancel = Not bolSaved 75 | Case vbCancel 76 | Cancel = True 77 | End Select 78 | End If 79 | End Sub 80 | 81 | Private Sub mws_SelectionChange(ByVal Target As Range) 82 | If mws.Range(mstrdbDataValidationList) = "" Then 83 | mstrLastRecord = "New " & mstrdbRecordName 84 | Else 85 | mstrLastRecord = mws.Range(mstrdbDataValidationList) 86 | End If 87 | End Sub 88 | 89 | Private Sub mws_Change(ByVal Target As Range) 90 | Select Case Target.Address 91 | Case Is = mws.Range(mstrdbDataValidationList).Address 92 | 'User is trying to load a new Record 93 | TryToLoadSelectedRecord 94 | Case Else 95 | 'Sheet data has changed 96 | Me.Dirty = True 97 | If mws.Range(mstrdbDataValidationList) = "New " & mstrdbRecordName Then 98 | Application.EnableEvents = False 99 | mws.Range(mstrdbDataValidationList) = "" 100 | Application.EnableEvents = True 101 | End If 102 | End Select 103 | End Sub 104 | 105 | Private Sub TryToLoadSelectedRecord() 106 | Dim ws As Worksheet 107 | Dim strMsg As String 108 | Dim strNewRecord As String 109 | 110 | Set ws = ActiveSheet 111 | strNewRecord = ws.Range(mstrdbDataValidationList) 112 | 113 | 'Verify if current Record had been changed 114 | If Me.Dirty Then 115 | 'Save current Record before change it? 116 | strMsg = mstrLastRecord & " data had been changed." & vbCrLf & vbCrLf 117 | strMsg = strMsg & "Save " & mstrLastRecord & " before load '" & strNewRecord & "'?" 118 | If MsgBox(strMsg, vbQuestion + vbYesNo, "Save current data?") = vbYes Then 119 | If Not Save(mstrLastRecord) Then 120 | 'Record data not saved! 121 | Application.EnableEvents = False 122 | ws.Range(mstrdbDataValidationList) = mstrLastRecord 123 | Application.EnableEvents = True 124 | Exit Sub 125 | End If 126 | End If 127 | Me.Dirty = False 128 | End If 129 | 130 | 'Load selected Record data 131 | Call Load(strNewRecord) 132 | End Sub 133 | 134 | Private Sub Load(strRecord As String) 135 | 'Disable screen updating, events and recalc 136 | SetScreenEventsRecalc (False) 137 | Select Case strRecord 138 | Case "", "New " & mstrdbRecordName 139 | 'User selected a "New Record" 140 | Call Clear 141 | mws.Range(mstrdbDataValidationList) = "New " & mstrdbRecordName 142 | Case Else 143 | Call LoadSaveData(strRecord, LoadRecord) 144 | mws.Range(mstrdbDataValidationList).Select 145 | mstrLastRecord = strRecord 146 | End Select 147 | Me.Dirty = False 148 | 'Enable screen updating, events and recalc 149 | SetScreenEventsRecalc (True) 150 | End Sub 151 | 152 | Private Sub LoadSaveData(strRecord As String, Perform As Operation) 153 | Dim rg As Range 154 | Dim rgCells As Range 155 | Dim rgArea As Range 156 | Dim rgAreaColumn As Range 157 | Dim strRangeName As String 158 | Dim strRelation As String 159 | Dim intOffSet As Integer 160 | Dim intRelation As Integer 161 | Dim intRow As Integer 162 | Dim intCol As Integer 163 | Dim intAreaCol As Integer 164 | Dim intMaxRows As Integer 165 | 166 | Set rg = mws.Range(mstrdbSavedRecords).Find(strRecord, , , xlWhole) 167 | 168 | 'Load/Save one side worksheet records (one cell at a time) 169 | If Len(mstrdbOneSide) Then 170 | Set rgCells = mws.Range(mstrdbOneSide) 171 | For Each rgArea In rgCells.Areas 172 | For intRow = 1 To rgArea.Rows.Count 173 | For intCol = 1 To rgArea.Columns.Count 174 | If Perform = SaveRecord Then 175 | rg.Offset(0, mintdbRangeOffset + intOffSet) = rgArea.Cells(intRow, intCol) 176 | Else 177 | rgArea.Cells(intRow, intCol) = rg.Offset(0, mintdbRangeOffset + intOffSet) 178 | End If 179 | intOffSet = intOffSet + 1 180 | If rgArea.Cells(intRow, intCol).MergeCells Then 181 | intRow = intRow + rgArea.Cells(intRow, intCol).MergeArea.Rows.Count - 1 182 | intCol = intCol + rgArea.Cells(intRow, intCol).MergeArea.Columns.Count - 1 183 | End If 184 | Next 185 | Next 186 | Next 187 | End If 188 | 189 | 'Load/Save many side worksheet records 190 | strRangeName = mstrdbManySidePrefix & FixName(strRecord) 191 | 'Process each many-side records range Relation 192 | intRow = 0 193 | For intRelation = 1 To 4 194 | strRelation = Choose(intRelation, mstrdbManySide1, mstrdbManySide2, mstrdbManySide3, mstrdbManySide4) 195 | If Len(strRelation) Then 196 | intCol = 0 197 | intMaxRows = 0 198 | Set rgCells = mws.Range(strRelation) 199 | For Each rgArea In rgCells.Areas 200 | For intAreaCol = 0 To rgArea.Columns.Count - 1 201 | Set rg = mws.Range(strRangeName).Offset(intRow, intCol) 202 | Set rg = rg.Resize(rgArea.Rows.Count, 1) 203 | Set rgAreaColumn = mws.Range(mws.Cells(rgArea.Row, rgArea.Column + intAreaCol), _ 204 | mws.Cells(rgArea.Row + rgArea.Rows.Count - 1, rgArea.Column + intAreaCol)) 205 | If Perform = SaveRecord Then 206 | rg.Value = rgAreaColumn.Value 207 | Else 208 | rgAreaColumn.Value = rg.Value 209 | End If 210 | 211 | If rgArea.Cells(1, intAreaCol + 1).MergeCells Then 212 | intAreaCol = intAreaCol + rgArea.Cells(1, intAreaCol + 1).MergeArea.Columns.Count - 1 213 | End If 214 | intCol = intCol + 1 215 | Next 216 | 217 | If intMaxRows < rgArea.Rows.Count Then 218 | intMaxRows = rgArea.Rows.Count 219 | End If 220 | Next 221 | intRow = intRow + intMaxRows + 1 222 | End If 223 | Next 224 | End Sub 225 | 226 | Public Function Save(Optional strLastRecord As String) As Boolean 227 | Dim rg As Range 228 | Dim strRecord As String 229 | Dim bolNewRecord As Boolean 230 | Dim bolRecordSaved As Boolean 231 | 232 | 'Verify if Record data is still empty 233 | strRecord = mws.Range(mstrdbDataValidationList) 234 | If strRecord = "New " & mstrdbRecordName Then 235 | Exit Function 236 | End If 237 | 238 | If strLastRecord = "" Then 239 | strLastRecord = strRecord 240 | End If 241 | strRecord = GetRecordName(strLastRecord, bolNewRecord) 242 | 243 | If Len(strRecord) Then 244 | 'Disable application events to allow cell change by macro code 245 | SetScreenEventsRecalc (False) 246 | mws.Unprotect 247 | bolRecordSaved = SaveData(strRecord, bolNewRecord) 248 | mws.Protect 249 | If bolRecordSaved Then 250 | 'Define current Record as saved Record 251 | mws.Range(mstrdbDataValidationList) = strRecord 252 | mws.Range(mstrdbDataValidationList).Select 253 | 254 | 'Save the worbook 255 | ThisWorkbook.Save 256 | mstrLastRecord = strRecord 257 | Me.Dirty = False 258 | Save = True 259 | MsgBox mstrdbRecordName & " data had been saved as '" & strRecord & "'!", , "BMI Companion Chart" 260 | Else 261 | MsgBox "There is no more room to save data on this worksheet!", vbCritical, "Can't save data" 262 | End If 263 | SetScreenEventsRecalc (True) 264 | End If 265 | End Function 266 | 267 | Private Function SaveData(strRecord As String, bolNewRecord As Boolean) As Boolean 268 | Dim rg As Range 269 | Dim strRangeName As String 270 | Dim strAddress As String 271 | Dim lngRow As Long 272 | Dim bolWorksheetIsFull As Boolean 273 | 274 | Set rg = mws.Range(mstrdbSavedRecords) 275 | If bolNewRecord Then 276 | 'Define sheet row where next Record data will be stored 277 | lngRow = NextEntryRow(bolWorksheetIsFull) 278 | 279 | 'Verify if sheet can receive more records 280 | If bolWorksheetIsFull Then 281 | 'No more room to save data 282 | Exit Function 283 | End If 284 | 285 | 'Insert a new row at bottom of mstrdbSavedRecords range name and update rg object 286 | rg.Resize(rg.Rows.Count + 1).Name = "'" & mws.Name & "'!" & mstrdbSavedRecords 287 | Set rg = mws.Range(mstrdbSavedRecords) 288 | 289 | 'Position on new cell of mstrdbSavedRecords range and save new Record name 290 | rg.Cells(rg.Rows.Count, 1) = strRecord 291 | 292 | If Len(mstrdbManySide1) Then 293 | 'Define many-side Record name as 'mstrdbManySidePrefix' and create tbe range name 294 | strRangeName = mstrdbManySidePrefix & FixName(strRecord) 295 | strAddress = "='" & mws.Name & "'!" & mstrdbManySideFirstColumn & lngRow 296 | mws.Names.Add strRangeName, strAddress, False 297 | End If 298 | End If 299 | 300 | Call LoadSaveData(strRecord, SaveRecord) 301 | 302 | 'Sort mstrdbSavedRecords range keeping "New " on the top of the list 303 | Set rg = mws.Range(Cells(rg.Row + 1, rg.Column), _ 304 | Cells(rg.Row + rg.Rows.Count, rg.Column + mintdbRangeOffset + mintdbOneSideColumsCount)) 305 | rg.EntireRow.Hidden = False 306 | rg.Sort rg.Cells(, 1) 307 | rg.EntireRow.Hidden = True 308 | 309 | mws.Range("A1").Select 310 | SaveData = True 311 | End Function 312 | 313 | Private Function GetRecordName(strRecord As String, bolNewRecord As Boolean) As String 314 | Dim rg As Range 315 | Dim strNewRecord As String 316 | Static sintDefaultName As Integer 317 | 318 | If strRecord = "" Then 319 | sintDefaultName = sintDefaultName + 1 320 | strRecord = "New " & mstrdbRecordName & " " & Replace(Date, "/", "_") 321 | If sintDefaultName > 1 Then 322 | strRecord = strRecord & " " & sintDefaultName 323 | End If 324 | strRecord = InputBox("Data will be saved as:", "Confirm data name", strRecord) 325 | End If 326 | 327 | If Len(strRecord) Then 328 | 'Verify if strRecord already exist on mstrdbSavedRecords 329 | Set rg = mws.Range(mstrdbSavedRecords).Find(strRecord) 330 | 331 | If rg Is Nothing Then 332 | bolNewRecord = True 333 | Else 334 | 'Confirm proposed record name 335 | strNewRecord = InputBox(mstrdbRecordName & " '" & strRecord & "' already exist. Do you want to overwrite it?", _ 336 | "Overwrite " & strRecord & " data?", strRecord) 337 | If strRecord <> strNewRecord Then 338 | 'Proposed record name changed. Verify if new name alteady exist 339 | Set rg = mws.Range(mstrdbSavedRecords).Find(strNewRecord) 340 | If rg Is Nothing Then 341 | bolNewRecord = True 342 | Else 343 | 'New name already exist. Confirm overwrite 344 | If MsgBox("The name you typed, '" & strNewRecord & "', already exist. Overwrite it?", _ 345 | vbYesNo + vbDefaultButton2 + vbQuestion, _ 346 | "Overwrite '" & strNewRecord & "'?") = vbNo Then 347 | strNewRecord = "" 348 | End If 349 | End If 350 | strRecord = strNewRecord 351 | End If 352 | End If 353 | End If 354 | 355 | GetRecordName = strRecord 356 | End Function 357 | 358 | Private Function NextEntryRow(bolWorksheetIsFull As Boolean) As Long 359 | Dim lngRow As Long 360 | 361 | If Len(mstrdbManySide1) Then 362 | 'Use many-side records to find next entry row 363 | lngRow = mintdbRecordsFirstRow + (mws.Range(mstrdbSavedRecords).Rows.Count - 1) * mintdbManySideRowsCount 364 | If lngRow < mws.UsedRange.Rows.Count Then 365 | lngRow = mintdbRecordsFirstRow + (mws.Range(mstrdbSavedRecords).Rows.Count * mintdbManySideRowsCount) 366 | End If 367 | bolWorksheetIsFull = (lngRow > (mws.Rows.Count - mintdbManySideRowsCount)) 368 | Else 369 | 'Just one-side record to find next entry row 370 | lngRow = mintdbRecordsFirstRow + mws.Range(mstrdbSavedRecords).Rows.Count 371 | bolWorksheetIsFull = (lngRow > (mws.Rows.Count - mws.Range(mstrdbSavedRecords).Rows.Count)) 372 | End If 373 | 374 | NextEntryRow = lngRow 375 | End Function 376 | 377 | Private Sub Clear() 378 | Dim rgCells As Range 379 | Dim strRange As String 380 | Dim intI As Integer 381 | 382 | 'Clear one side worksheet records 383 | If Len(mstrdbOneSide) Then 384 | Set rgCells = mws.Range(mstrdbOneSide) 385 | rgCells = "" 386 | End If 387 | 388 | 'Clear many side worksheet records 389 | For intI = 1 To 4 390 | strRange = Choose(intI, mstrdbManySide1, mstrdbManySide2, mstrdbManySide3, mstrdbManySide4) 391 | If Len(strRange) Then 392 | Set rgCells = mws.Range(strRange) 393 | rgCells = "" 394 | End If 395 | Next 396 | End Sub 397 | 398 | Public Function DeleteRecord() As Boolean 399 | Dim strRecord As String 400 | Dim strMsg As String 401 | Dim strTitle As String 402 | Dim intCancelDelete As Integer 403 | Dim intCancelSave As Integer 404 | Dim bolNewRecord As Boolean 405 | 406 | strRecord = mws.Range(mstrdbDataValidationList) 407 | If strRecord = "" Or strRecord = "New " & mstrdbRecordName Then 408 | If Me.Dirty Then 409 | bolNewRecord = True 410 | strMsg = "New " & mstrdbRecordName & " data has not been saved yet." & vbCrLf 411 | strMsg = strMsg & "Do you want to delete it?" 412 | strTitle = "Delete unsaved record?" 413 | Else 414 | Exit Function 415 | End If 416 | Else 417 | strMsg = "Do you want to delete " & strRecord & " record?" 418 | strTitle = "Delete record?" 419 | End If 420 | 421 | If MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbQuestion, strTitle) = vbYes Then 422 | 'Disable screen updating, events and recalc 423 | SetScreenEventsRecalc (False) 424 | Call Clear 425 | If Not bolNewRecord Then 426 | Call DeleteRecordData(strRecord) 427 | End If 428 | DeleteRecord = True 429 | Me.Dirty = False 430 | mstrLastRecord = "New " & mstrdbRecordName 431 | 'Enabled screen updating, events and recalc 432 | SetScreenEventsRecalc (True) 433 | 434 | mws.Range(mstrdbDataValidationList) = mstrLastRecord 435 | 436 | 'Save workbook after deletion 437 | ThisWorkbook.Save 438 | End If 439 | End Function 440 | 441 | Private Sub DeleteRecordData(strRecord As String) 442 | Dim rg As Range 443 | Dim rgRecord As Range 444 | Dim strRecordRange As String 445 | Dim lngLastRow As Long 446 | Dim lngSafeRow As Long 447 | Dim intColumns As Integer 448 | 449 | mws.Unprotect 450 | Set rg = mws.Range(mstrdbSavedRecords) 451 | 'Get the last row used by Database parameters 452 | lngSafeRow = mintdbRecordsFirstRow 453 | lngLastRow = rg.Row + rg.Rows.Count - 1 454 | 'Set the last safe sheet row to delete entire row 455 | If lngSafeRow < lngLastRow Then 456 | lngSafeRow = lngLastRow 457 | End If 458 | 459 | 'Delete the One-side record from mstrdbSavedRecords range 460 | Set rgRecord = rg.Find(strRecord) 461 | intColumns = mintdbRangeOffset + mintdbOneSideColumsCount 462 | rgRecord.Resize(1, intColumns).ClearContents 463 | 464 | If rgRecord.Row <> lngLastRow Then 465 | 'Reposition other record entries by copy and paste 466 | mws.Range(Cells(rgRecord.Row + 1, rgRecord.Column), Cells(lngLastRow, rgRecord.Column + intColumns - 1)).Copy 467 | rgRecord.PasteSpecial xlPasteValues 468 | End If 469 | 470 | 'Clear last mstrdbSavedRecords record row 471 | Range(Cells(lngLastRow, rgRecord.Column), Cells(lngLastRow, rgRecord.Column + intColumns - 1)).ClearContents 472 | 'Resize mstrdbSavedRecords range name without deleted Record 473 | rg.Resize(rg.Rows.Count - 1).Name = "'" & mws.Name & "'!" & mstrdbSavedRecords 474 | 475 | 'Delete the Many-side records and it range name 476 | strRecordRange = mstrdbManySidePrefix & FixName(strRecord) 477 | Set rg = mws.Range(strRecordRange) 478 | 'Verify if record data amd mstrdbSavedRecords range use the same rows 479 | If rg.Row <= lngSafeRow Then 480 | 'This saved records data rows must just be cleaned 481 | rg.Resize(mintdbManySideRowsCount, mintdbManySideColumnsCount).ClearContents 482 | Else 483 | 'It is safe to delete entire saved records data rows 484 | rg.Resize(mintdbManySideRowsCount).EntireRow.Delete 485 | 'Provision to keep rows hidden 486 | mws.Range(Cells(mintdbRecordsFirstRow, 1), Cells(mws.Rows.Count, 1)).EntireRow.Hidden = True 487 | End If 488 | 'Delete the many-records Range name 489 | mws.Names(strRecordRange).Delete 490 | 'Scroll to row 1 491 | ActiveWindow.ScrollRow = 1 492 | mws.Protect 493 | End Sub 494 | 495 | 496 | 497 | 498 | 499 | 500 | -------------------------------------------------------------------------------- /Ch08/frmDBProperties.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmDBProperties 3 | Caption = "Database Properties" 4 | ClientHeight = 7920 5 | ClientLeft = 45 6 | ClientTop = 330 7 | ClientWidth = 9765 8 | OleObjectBlob = "frmDBProperties.frx":0000 9 | StartUpPosition = 1 'CenterOwner 10 | End 11 | Attribute VB_Name = "frmDBProperties" 12 | Attribute VB_GlobalNameSpace = False 13 | Attribute VB_Creatable = False 14 | Attribute VB_PredeclaredId = True 15 | Attribute VB_Exposed = False 16 | 17 | 18 | 19 | Option Explicit 20 | 21 | Private Enum ShowTab 22 | PreviousTab = -1 23 | NextTab = 1 24 | End Enum 25 | 26 | Private Enum DataBaseOperation 27 | CreateDatabase = 1 28 | RemoveDatabase = 2 29 | End Enum 30 | 31 | Private Sub chkCreateNavigationButtons_Click() 32 | Me.cmdRecordPosition.Enabled = Me.chkCreateNavigationButtons 33 | Me.txtRecordPosition.Enabled = Me.chkCreateNavigationButtons 34 | End Sub 35 | 36 | Private Sub UserForm_Initialize() 37 | Dim ws As Worksheet 38 | Dim rg As Range 39 | Dim strName As String 40 | Dim strNameScope As String 41 | Dim intI As Integer 42 | Const conNormalWidth = 473 43 | Const conWhite = &HFFFFFF 44 | 45 | On Error Resume Next 46 | 47 | Me.Width = conNormalWidth 48 | Application.EnableEvents = False 49 | Set ws = Application.ActiveSheet 50 | strNameScope = "'" & ws.Name & "'!" 51 | Me.tabControl.Style = fmTabStyleNone 52 | 53 | Set rg = Range(strNameScope & "dbDataValidationList") 54 | If rg Is Nothing Then 55 | Me.tabControl.Value = 0 56 | Me.cmdPrevious.Visible = True 57 | Me.cmdNext.Visible = True 58 | Me.txtdbRecordsFirstRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count + 3 59 | Me.txtRecordPosition = SetRecordPosition() 60 | Call LoadNames 61 | Else 62 | Me.cmdDefine.Caption = "Close" 63 | Me.cmdDefine.Accelerator = "C" 64 | Me.cmdDefine.Enabled = True 65 | Me.cmdCancel.Caption = "Remove" 66 | Me.cmdCancel.Accelerator = "R" 67 | Me.cmdPrevious.Visible = False 68 | Me.cmdNext.Visible = False 69 | Me.txtdbRecordName1.Locked = True 70 | Me.txtdbRecordName1.BackColor = conWhite 71 | Me.txtdbManySidePrefix.Locked = True 72 | Me.txtdbManySidePrefix.BackColor = conWhite 73 | 74 | 'Update UserForm TextBoxes 75 | For intI = 1 To 15 76 | strName = Choose(intI, "dbRecordName", _ 77 | "dbDataValidationList", _ 78 | "dbSavedRecords", _ 79 | "dbRecordsFirstRow", _ 80 | "dbOneSide", _ 81 | "dbOneSideColumnsCount", _ 82 | "dbManySide1", _ 83 | "dbManySide2", _ 84 | "dbManySide3", _ 85 | "dbManySide4", _ 86 | "dbManySideFirstColumn", _ 87 | "dbManySideColumnsCount", _ 88 | "dbManySideRowsCount", _ 89 | "dbManySidePrefix", _ 90 | "dbRangeOffset") 91 | Me("txt" & strName) = ws.Range(strNameScope & strName) 92 | Next 93 | 94 | Me.tabControl.Value = Me.tabControl.Pages.Count - 1 95 | Call CalculateManySideRecords 96 | End If 97 | End Sub 98 | 99 | Private Sub UserForm_Terminate() 100 | Application.EnableEvents = True 101 | End Sub 102 | 103 | Private Sub LoadNames(Optional bolAllRangeNames As Boolean) 104 | Dim obj As Object 105 | Dim nm As Name 106 | Dim varNames() As Variant 107 | Dim intI As Integer 108 | 109 | On Error Resume Next 110 | 111 | 'Load desired names on varNames() array 112 | If bolAllRangeNames Then 113 | Set obj = ThisWorkbook 114 | Else 115 | Set obj = ActiveSheet 116 | End If 117 | 118 | ReDim varNames(obj.Names.Count - 1) 119 | 120 | For Each nm In obj.Names 121 | varNames(intI) = nm.Name 122 | intI = intI + 1 123 | Next 124 | 125 | 'Populate Comboboxes 126 | Me.cbodbOneSide.List = varNames() 127 | Me.cbodbManySide1.List = varNames() 128 | Me.cbodbManySide2.List = varNames() 129 | Me.cbodbManySide3.List = varNames() 130 | Me.cbodbManySide4.List = varNames() 131 | End Sub 132 | 133 | Private Sub chkWorkbookNames_Click() 134 | Call LoadNames(Me.chkWorkbookNames) 135 | End Sub 136 | 137 | Private Sub cmdNext_Click() 138 | Call ShowPage(NextTab) 139 | End Sub 140 | 141 | Private Sub cmdPrevious_Click() 142 | Call ShowPage(PreviousTab) 143 | End Sub 144 | 145 | Private Sub ShowPage(Action As ShowTab) 146 | Static sintPage As Integer 147 | Dim intMaxPages As Integer 148 | 149 | If Action = NextTab Then 150 | If Not ValidatePage(sintPage) Then Exit Sub 151 | End If 152 | 153 | sintPage = sintPage + Action 154 | intMaxPages = Me.tabControl.Pages.Count - 1 155 | 156 | If sintPage < 0 Then sintPage = 0 157 | If sintPage > intMaxPages Then sintPage = intMaxPages 158 | Me.tabControl.Value = sintPage 159 | Me.cmdDefine.Enabled = (sintPage = Me.tabControl.Pages.Count - 1) 160 | Me.chkWorkbookNames.Visible = (sintPage = 2 Or sintPage = 3) 161 | End Sub 162 | 163 | Function ValidatePage(intPage As Integer) As Boolean 164 | Dim strMsg As String 165 | Dim strTitle As String 166 | Dim bolValidateFail As Boolean 167 | 168 | Select Case intPage 169 | Case 0 170 | 'Validata record name 171 | If Len(Me.txtdbRecordName) = 0 Then 172 | strMsg = "Define the default name for the worksheet record." 173 | strTitle = "Record name?" 174 | bolValidateFail = True 175 | End If 176 | Case 1 177 | 'Validata Data Validation list 178 | If Len(Me.txtdbDataValidationList) = 0 Then 179 | strMsg = "Select a cell for the Records Data Validation list and try again." 180 | strTitle = "Data Validation list cell?" 181 | bolValidateFail = True 182 | End If 183 | Case 3 184 | 'Validata OneSide and ManySide records 185 | If Me.txtdbOneSideColumnsCount = 0 And Me.txtdbManySideRowsCount = 0 Then 186 | strMsg = "Select the One-Side and/or the Many-Side cells that define the worksheet records ranges!" 187 | strTitle = "Select cells to be saved as worksheet records" 188 | bolValidateFail = True 189 | End If 190 | End Select 191 | 192 | If bolValidateFail Then 193 | MsgBox strMsg, vbQuestion, strTitle 194 | Else 195 | ValidatePage = True 196 | End If 197 | End Function 198 | 199 | Private Sub tabControl_Change() 200 | Dim lngRec As Long 201 | 202 | On Error Resume Next 203 | 204 | If Me.txtdbManySideRowsCount = 0 Then 205 | lngRec = (ActiveSheet.Rows.Count - Me.txtdbRecordsFirstRow) 206 | Else 207 | lngRec = (ActiveSheet.Rows.Count - Me.txtdbRecordsFirstRow) / Me.txtdbManySideRowsCount 208 | End If 209 | Me.lblNumRecords.Caption = lngRec & " records allowed" 210 | Me.cmdPrevious.Enabled = (Me.tabControl.Value > 0) 211 | Me.cmdNext.Enabled = (Me.tabControl.Value < Me.tabControl.Pages.Count - 1) 212 | End Sub 213 | 214 | Private Sub txtdbRecordName_Change() 215 | Me.txtdbRecordName1 = Me.txtdbRecordName 216 | End Sub 217 | 218 | Private Sub cmdDataValidationList_Click() 219 | Dim varFormula As Variant 220 | Dim varName As Variant 221 | Dim strListRange As String 222 | Dim strRange As String 223 | 224 | On Error Resume Next 225 | 226 | Me.Hide 227 | strRange = GetRange("Select cell for the Data Validation list:", "Data Validation List?", Me.txtdbDataValidationList) 228 | If Len(strRange) Then 229 | varName = Range(strRange).Name.Name 230 | If Len(varName) Then 231 | strRange = varName 232 | End If 233 | Me.txtdbDataValidationList = strRange 234 | Range(strRange).Merge 235 | 236 | 'Verify if selected range has a data validation list 237 | strListRange = Range(strRange).Validation.Formula1 238 | If Len(strListRange) Then 239 | Me.txtdbSavedRecords = Mid(strListRange, 2) 240 | Else 241 | Me.txtdbSavedRecords = "SavedRecords" 242 | End If 243 | End If 244 | Me.Show 245 | End Sub 246 | 247 | Private Function GetRange(strMsg As String, strTitle As String, Optional Default As Variant) As String 248 | Dim varRg As Variant 249 | Dim rgArea As Range 250 | Dim strAddress As String 251 | Dim bolInvalidSelection As Boolean 252 | Const conRange = 8 253 | 254 | On Error Resume Next 255 | 256 | Set varRg = Application.InputBox(strMsg, strTitle, Default, , , , , conRange) 257 | If IsObject(varRg) Then 258 | For Each rgArea In varRg.Areas 259 | If Len(strAddress) Then 260 | strAddress = strAddress & "," 261 | End If 262 | strAddress = strAddress & rgArea.Address 263 | Next 264 | GetRange = strAddress 265 | End If 266 | End Function 267 | 268 | Private Sub txtdbDataValidationList_Change() 269 | Me.txtdbDataValidationList1 = Me.txtdbDataValidationList 270 | End Sub 271 | 272 | Private Sub cmddbOneSide_Click() 273 | Dim strRange As String 274 | Dim strMsg As String 275 | 276 | On Error Resume Next 277 | 278 | Me.Hide 279 | strMsg = "Select all cells that belongs to the 'one side' of the worksheet record." & vbCrLf 280 | strRange = GetRange(strMsg, "One-side record sheet cells", Me.cbodbOneSide) 281 | If Len(strRange) Then 282 | Me.cbodbOneSide = strRange 283 | End If 284 | Me.Show 285 | End Sub 286 | 287 | Private Sub cbodbOneSide_Change() 288 | Dim intCells As Integer 289 | Dim strAddress As String 290 | Const conColsDatabase = 6 291 | 292 | If IsRange(Me.cbodbOneSide) Then 293 | 'Count cells selected 294 | intCells = CalculateOneSideColumns() 295 | Me.txtdbOneSideColumnsCount = intCells 296 | 'Define save column for many-side records 297 | strAddress = Cells(1, intCells + conColsDatabase).Address 298 | strAddress = Left(strAddress, InStrRev(strAddress, "$")) 299 | Me.txtdbManySideFirstColumn = strAddress 300 | Else 301 | Me.cbodbOneSide = "" 302 | Me.txtdbOneSideColumnsCount = 0 303 | Me.txtdbManySideFirstColumn = "" 304 | End If 305 | 306 | If Left(Me.cbodbOneSide, 1) = "'" Then 307 | Me.txtdbOneSide = "'" & Me.cbodbOneSide 308 | Else 309 | Me.txtdbOneSide = Me.cbodbOneSide 310 | End If 311 | Me.cmdClearcbodbOneSide.Enabled = (Len(Me.cbodbOneSide) > 0) 312 | End Sub 313 | 314 | Private Function IsRange(strRange As String) As Boolean 315 | Dim rg As Range 316 | 317 | On Error Resume Next 318 | Set rg = Range(strRange) 319 | IsRange = (Err = 0) 320 | End Function 321 | 322 | Private Function CalculateOneSideColumns() As Integer 323 | Dim rg As Range 324 | Dim rgArea As Range 325 | Dim strAddress As String 326 | Dim intNumCols As Integer 327 | Dim intI As Integer 328 | Dim intJ As Integer 329 | 330 | Set rg = Range(Me.cbodbOneSide) 331 | For Each rgArea In rg.Areas 332 | For intI = 1 To rgArea.Rows.Count 333 | For intJ = 1 To rgArea.Columns.Count 334 | If rgArea.Cells(intI, intJ).MergeCells Then 335 | intI = intI + rgArea.Cells(intI, intJ).MergeArea.Rows.Count - 1 336 | intJ = intJ + rgArea.Cells(intI, intJ).MergeArea.Columns.Count - 1 337 | End If 338 | intNumCols = intNumCols + 1 339 | Next intJ 340 | Next intI 341 | Next 342 | CalculateOneSideColumns = intNumCols 343 | End Function 344 | 345 | Private Sub txtdbOneSideColumnsCount_Change() 346 | Me.txtdbOneSideColumnsCount1 = Me.txtdbOneSideColumnsCount 347 | End Sub 348 | 349 | Private Sub cmdClearcbodbOneSide_Click() 350 | Me.cbodbOneSide = "" 351 | End Sub 352 | 353 | Private Sub cmddbManySide1_Click() 354 | Call GetdbManySide(1) 355 | End Sub 356 | 357 | Private Sub cmddbManySide2_Click() 358 | Call GetdbManySide(2) 359 | End Sub 360 | 361 | Private Sub cmddbManySide3_Click() 362 | Call GetdbManySide(3) 363 | End Sub 364 | 365 | Private Sub cmddbManySide4_Click() 366 | Call GetdbManySide(4) 367 | End Sub 368 | 369 | Private Sub cbodbManySide1_Change() 370 | If IsRange(Me.cbodbManySide1) Then 371 | If Left(Me.cbodbManySide1, 1) = "'" Then 372 | Me.txtdbManySide1 = "'" & Me.cbodbManySide1 373 | Else 374 | Me.txtdbManySide1 = Me.cbodbManySide1 375 | End If 376 | Else 377 | Me.cbodbManySide1 = "" 378 | Me.txtdbManySide1 = "" 379 | End If 380 | 381 | Me.cmdClear1.Enabled = (Len(Me.cbodbManySide1) > 0) 382 | Me.cbodbManySide2.Enabled = (Len(Me.cbodbManySide1) > 0) 383 | Me.cmddbManySide2.Enabled = (Len(Me.cbodbManySide1) > 0) 384 | Call CalculateManySideRecords 385 | End Sub 386 | 387 | Private Sub cbodbManySide2_Change() 388 | If IsRange(Me.cbodbManySide2) Then 389 | If Left(Me.cbodbManySide2, 1) = "'" Then 390 | Me.txtdbManySide2 = "'" & Me.cbodbManySide2 391 | Else 392 | Me.txtdbManySide2 = Me.cbodbManySide2 393 | End If 394 | Else 395 | Me.cbodbManySide2 = "" 396 | Me.txtdbManySide2 = "" 397 | End If 398 | 399 | Me.cmdClear2.Enabled = (Len(Me.cbodbManySide2) > 0) 400 | Me.cbodbManySide3.Enabled = (Len(Me.cbodbManySide2) > 0) 401 | Me.cmddbManySide3.Enabled = (Len(Me.cbodbManySide1) > 0 And Len(Me.cbodbManySide2) > 0) 402 | Call CalculateManySideRecords 403 | End Sub 404 | 405 | Private Sub cbodbManySide3_Change() 406 | If IsRange(Me.cbodbManySide3) Then 407 | If Left(Me.cbodbManySide3, 1) = "'" Then 408 | Me.txtdbManySide3 = "'" & Me.cbodbManySide3 409 | Else 410 | Me.txtdbManySide3 = Me.cbodbManySide3 411 | End If 412 | Else 413 | Me.cbodbManySide3 = "" 414 | Me.txtdbManySide3 = "" 415 | End If 416 | 417 | Me.cmdClear3.Enabled = (Len(Me.cbodbManySide3) > 0) 418 | Me.cbodbManySide4.Enabled = (Len(Me.cbodbManySide3) > 0) 419 | Me.cmddbManySide4.Enabled = (Len(Me.cbodbManySide1) > 0 And Len(Me.cbodbManySide2) > 0 And Len(Me.cbodbManySide3) > 0) 420 | Call CalculateManySideRecords 421 | End Sub 422 | 423 | Private Sub cbodbManySide4_Change() 424 | If IsRange(Me.cbodbManySide4) Then 425 | If Left(Me.cbodbManySide4, 1) = "'" Then 426 | Me.txtdbManySide4 = "'" & Me.cbodbManySide4 427 | Else 428 | Me.txtdbManySide4 = Me.cbodbManySide4 429 | End If 430 | Else 431 | Me.cbodbManySide4 = "" 432 | Me.txtdbManySide4 = "" 433 | End If 434 | 435 | Me.cmdClear4.Enabled = (Len(Me.cbodbManySide4) > 0) 436 | Call CalculateManySideRecords 437 | End Sub 438 | 439 | Private Function CalculateManySideRecords() As Integer 440 | Dim rg As Range 441 | Dim rgArea As Range 442 | Dim strCtl As String 443 | Dim strRange As String 444 | Dim intI As Integer 445 | Dim intJ As Integer 446 | Dim intMaxRows As Integer 447 | Dim intNumRows As Integer 448 | Dim intMaxCols As Integer 449 | Dim intNumCols As Integer 450 | Dim intPos As Integer 451 | Dim intPos2 As Integer 452 | Dim nm As Name 453 | 454 | 'Count how many rows are needed to save all range relations 455 | For intI = 1 To 4 456 | strCtl = Choose(intI, "cbodbManySide1", _ 457 | "cbodbManySide2", _ 458 | "cbodbManySide3", _ 459 | "cbodbManySide4") 460 | 461 | strRange = Me(strCtl) 462 | If Len(strRange) Then 463 | Set rg = Range(Me(strCtl)) 464 | For Each rgArea In rg.Areas 465 | If rgArea.Rows.Count > intMaxRows Then 466 | intMaxRows = rgArea.Rows.Count 467 | End If 468 | For intJ = 1 To rgArea.Columns.Count 469 | If rgArea.Cells(1, intJ).MergeCells Then 470 | intJ = intJ + rgArea.Cells(1, intJ).MergeArea.Columns.Count - 1 471 | End If 472 | intMaxCols = intMaxCols + 1 473 | Next intJ 474 | Next 475 | 'Add an extra row to separate each "many-side" relation 476 | intNumRows = intNumRows + intMaxRows + 1 477 | 'Update columns count 478 | If intMaxCols > intNumCols Then 479 | intNumCols = intMaxCols 480 | End If 481 | intMaxRows = 0 482 | intMaxCols = 0 483 | End If 484 | Next intI 485 | Me.txtdbManySideRowsCount = intNumRows 486 | Me.txtdbManySideColumnsCount = intNumCols 487 | End Function 488 | 489 | Private Sub txtdbManySideRowsCount_Change() 490 | Me.txtdbManySideRowsCount1 = Me.txtdbManySideRowsCount 491 | End Sub 492 | 493 | Private Sub txtdbManySideColumnsCount_Change() 494 | Me.txtdbManySideColumnsCount1 = Me.txtdbManySideColumnsCount 495 | End Sub 496 | 497 | Private Sub cmdClear1_Click() 498 | If Len(Me.cbodbManySide2) Then 499 | Me.cbodbManySide1 = Me.cbodbManySide2 500 | Call cmdClear2_Click 501 | Else 502 | Me.cbodbManySide1 = "" 503 | End If 504 | End Sub 505 | 506 | Private Sub cmdClear2_Click() 507 | If Len(Me.cbodbManySide3) Then 508 | Me.cbodbManySide2 = Me.cbodbManySide3 509 | Call cmdClear3_Click 510 | Else 511 | Me.cbodbManySide2 = "" 512 | End If 513 | End Sub 514 | 515 | Private Sub cmdClear3_Click() 516 | If Len(Me.cbodbManySide4) Then 517 | Me.cbodbManySide3 = Me.cbodbManySide4 518 | Me.cbodbManySide4 = "" 519 | Else 520 | Me.cbodbManySide3 = "" 521 | End If 522 | End Sub 523 | 524 | Private Sub cmdClear4_Click() 525 | Me.cbodbManySide4 = "" 526 | End Sub 527 | 528 | Private Sub cmdRecordPosition_Click() 529 | Dim strRange As String 530 | Dim strMsg As String 531 | Dim strRecordPosition As String 532 | 533 | On Error Resume Next 534 | 535 | strRecordPosition = SetRecordPosition() 536 | strMsg = "Select cell to receive Record Position indicator:" 537 | Me.Hide 538 | strRange = GetRange(strMsg, "Record Position cell?", Me.txtRecordPosition) 539 | If Len(strRange) Then 540 | If Range(strRange).Column < Range(strRecordPosition).Column Then 541 | MsgBox "There is no room to create data navigation controls on selected cell.", vbCritical, "Invalid selection!" 542 | Else 543 | Me.txtRecordPosition = strRange 544 | End If 545 | End If 546 | Me.Show 547 | End Sub 548 | 549 | Public Function SetRecordPosition() As String 550 | Dim rg As Range 551 | Dim sngWidth As Single 552 | Const conNavigationButtonWidth = 17.3 553 | Const conRecordPosiciontCellWidth = 50.25 554 | 555 | Set rg = Range("$B$" & Me.txtdbRecordsFirstRow - 2) 556 | sngWidth = rg.Offset(0, -1).Width 557 | Do While (sngWidth < conNavigationButtonWidth * 2) And _ 558 | (rg.Width < conRecordPosiciontCellWidth) 559 | sngWidth = sngWidth + rg.Width 560 | Set rg = rg.Offset(, 1) 561 | Loop 562 | SetRecordPosition = rg.Address(True, True) 563 | End Function 564 | 565 | Private Sub cmdCancel_Click() 566 | Dim strMsg As String 567 | Dim strTitle As String 568 | 569 | If Me.cmdCancel.Caption = "Remove" Then 570 | strMsg = "Do you really want to remove this Database structure?" & vbCrLf & vbCrLf 571 | strMsg = strMsg & " Just database properties will be removed. " & vbCrLf 572 | strMsg = strMsg & " Existing records will remain on the worksheet." & vbCrLf & vbCrLf 573 | strMsg = strMsg & "(This operation can be undone if close the workbook without saving it!)" 574 | strTitle = "Delete Database Properties?" 575 | If MsgBox(strMsg, vbYesNo + vbDefaultButton2 + vbCritical, strTitle) = vbYes Then 576 | 'Remove Database properties 577 | ActiveSheet.Unprotect 578 | Call SetDataBase(RemoveDatabase) 579 | End If 580 | End If 581 | Unload Me 582 | End Sub 583 | 584 | Private Function GetdbManySide(intRelation As Integer) As String 585 | Dim strMsg As String 586 | Dim strRange As String 587 | 588 | Me.Hide 589 | strMsg = "Select all column cells that belongs to the " & intRelation & " of the 'many side' worksheet record." & vbCrLf 590 | strRange = GetRange(strMsg, "Many-side record cells: " & intRelation, Me("cbodbManySide" & intRelation)) 591 | If Len(strRange) Then 592 | Me("cbodbManySide" & intRelation) = strRange 593 | End If 594 | Me.Show 595 | End Function 596 | 597 | Private Sub cmdDefine_Click() 598 | Dim rg As Range 599 | Dim strRange As String 600 | Dim intI As Integer 601 | Dim intRow As Integer 602 | Dim intCol As Integer 603 | 604 | ActiveSheet.Unprotect 605 | If Me.cmdDefine.Caption = "Define" Then 606 | 'Define database structure 607 | Call SetDataBase(CreateDatabase) 608 | End If 609 | 610 | 'Hide or show database rows 611 | ActiveSheet.Range(Cells(Me.txtdbRecordsFirstRow, 1), _ 612 | Cells(ActiveSheet.Rows.Count, 1)).EntireRow.Hidden = Me.chkHideDatabaseRows 613 | If Me.chkHideDatabaseRows Then 614 | 'Unlock worksheet record cells 615 | Range(Me.txtdbDataValidationList).MergeArea.Locked = False 616 | For intI = 1 To 5 617 | strRange = Choose(intI, "cbodbOneSide", _ 618 | "cbodbManySide1", _ 619 | "cbodbManySide2", _ 620 | "cbodbManySide3", _ 621 | "cbodbManySide4") 622 | If Len(Me(strRange)) Then 623 | For Each rg In Range(Me(strRange)).Areas 624 | For intRow = 1 To rg.Rows.Count 625 | For intCol = 1 To rg.Columns.Count 626 | rg.Cells(intRow, intCol).MergeArea.Locked = False 627 | Next 628 | Next 629 | Next 630 | End If 631 | Next 632 | 'Active worksheet protection, selecting just unlocked cells 633 | ActiveSheet.Protect 634 | ActiveSheet.EnableSelection = xlUnlockedCells 635 | End If 636 | 637 | Unload Me 638 | End Sub 639 | 640 | Private Sub SetDataBase(Operation As DataBaseOperation) 641 | Dim nm As Name 642 | Dim strNameScope As String 643 | Dim strName As String 644 | Dim intRow As Integer 645 | Dim intI As Integer 646 | Const conCol = "=$B$" 647 | Const conColD = 4 648 | 649 | Application.ScreenUpdating = False 650 | intRow = Me.txtdbRecordsFirstRow 651 | strNameScope = "'" & ActiveSheet.Name & "'!" 652 | 'Create database range names on columns A:B 653 | For intI = 0 To 14 654 | strName = Choose(intI + 1, "dbRecordName", _ 655 | "dbDataValidationList", _ 656 | "dbSavedRecords", _ 657 | "dbRecordsFirstRow", _ 658 | "dbOneSide", _ 659 | "dbOneSideColumnsCount", _ 660 | "dbManySide1", _ 661 | "dbManySide2", _ 662 | "dbManySide3", _ 663 | "dbManySide4", _ 664 | "dbManySideFirstColumn", _ 665 | "dbManySideColumnsCount", _ 666 | "dbManySideRowsCount", _ 667 | "dbManySidePrefix", _ 668 | "dbRangeOffset") 669 | If Operation = CreateDatabase Then 670 | Set nm = Names.Add(strNameScope & strName, conCol & intRow + intI, False) 671 | Cells(intRow + intI, 1) = strName 672 | Cells(intRow + intI, 2) = Me("txt" & strName) 673 | Else 674 | Set nm = Names(strNameScope & strName) 675 | nm.Delete 676 | Cells(intRow + intI, 1).ClearContents 677 | Cells(intRow + intI, 2).ClearContents 678 | End If 679 | Next 680 | 681 | If Operation = CreateDatabase Then 682 | 'Define SavedRecords range name on column D 683 | Set nm = Names.Add(strNameScope & Me.txtdbSavedRecords, "=" & Cells(intRow, conColD).Address, False) 684 | 'Define SavedRecords data validation list 685 | Range(strNameScope & Me.txtdbSavedRecords) = "New " & Me.txtdbRecordName 686 | Range(Me.txtdbDataValidationList).Validation.Delete 687 | Range(Me.txtdbDataValidationList).Validation.Add xlValidateList, , , "=" & Me.txtdbSavedRecords 688 | Range(Me.txtdbDataValidationList).HorizontalAlignment = xlLeft 689 | Range(Me.txtdbDataValidationList) = "New " & Me.txtdbRecordName 690 | Call CreateDatabaseButtons 691 | Else 692 | Set nm = Names(strNameScope & Me.txtdbSavedRecords) 693 | nm.Delete 694 | Range(Me.txtdbDataValidationList).Validation.Delete 695 | Call DeleteDatabaseButtons 696 | End If 697 | Application.ScreenUpdating = True 698 | End Sub 699 | 700 | Private Sub CreateDatabaseButtons() 701 | Dim ws As Worksheet 702 | Dim shp As Shape 703 | Dim rg As Range 704 | Dim dobjClipboard As New DataObject 705 | Dim strMsg As String 706 | Dim lngLeft As Long 707 | Const conColorLighBlue = 12419407 708 | Const conMoveButtonWidth = 17.25 709 | 710 | Set ws = Application.ActiveSheet 711 | 712 | If Me.chkCreateControlButtons Then 713 | 'Create Database ControlButtons at right of Data Validation list 714 | '--------------------------------------------------------------- 715 | Set rg = Range(Me.txtdbDataValidationList) 716 | If rg.MergeCells Then 717 | 'Range has merged cells. Position on last right cell 718 | Set rg = Cells(rg.Row, rg.Column + rg.MergeArea.Columns.Count - 1) 719 | End If 720 | 721 | 'Create New button 722 | lngLeft = rg.Left + rg.Width + 16 723 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, 30, rg.Height) 724 | shp.OnAction = "MoveNew" 725 | shp.OLEFormat.Object.Text = "New" 726 | 727 | 'Create Save button 728 | lngLeft = shp.Left + shp.Width + 5 729 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, 30, rg.Height) 730 | shp.OnAction = "Save" 731 | shp.OLEFormat.Object.Text = "Save" 732 | 733 | 'Create Delete button 734 | lngLeft = shp.Left + shp.Width + 5 735 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, 35, rg.Height) 736 | shp.OnAction = "Delete" 737 | shp.OLEFormat.Object.Text = "Delete" 738 | End If 739 | 740 | If Me.chkCreateNavigationButtons Then 741 | 'Create Data Navigation buttons 742 | '------------------------------------------ 743 | Set rg = Range(Me.txtRecordPosition) 744 | rg.Formula = "=RecordPosition()" 745 | rg.HorizontalAlignment = xlCenter 746 | rg.Font.Size = 9 747 | rg.Borders.LineStyle = xlContinuous 748 | rg.Borders.Color = conColorLighBlue 749 | 750 | 'Create MoveFirst button 751 | lngLeft = rg.Left - 2 * conMoveButtonWidth 752 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, conMoveButtonWidth, rg.Height) 753 | shp.OnAction = "MoveFirst" 754 | 'shp.OnAction = ws.CodeName & ".MoveFirst" 755 | shp.OLEFormat.Object.Text = "|<" 756 | 757 | 'Create MoveFirst button 758 | lngLeft = rg.Left - conMoveButtonWidth 759 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, conMoveButtonWidth, rg.Height) 760 | shp.OnAction = "MovePrevious" 761 | shp.OLEFormat.Object.Text = "<" 762 | 763 | 'Create MoveFirst button 764 | lngLeft = rg.Left + rg.Width 765 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, conMoveButtonWidth, rg.Height) 766 | shp.OnAction = "MoveNext" 767 | shp.OLEFormat.Object.Text = ">" 768 | 769 | 'Create MoveFirst button 770 | lngLeft = rg.Left + rg.Width + conMoveButtonWidth 771 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, conMoveButtonWidth, rg.Height) 772 | shp.OnAction = "MoveLast" 773 | shp.OLEFormat.Object.Text = ">|" 774 | 775 | 'Create MoveFirst button 776 | lngLeft = rg.Left + rg.Width + 2 * conMoveButtonWidth 777 | Set shp = ws.Shapes.AddFormControl(xlButtonControl, lngLeft, rg.Top, conMoveButtonWidth, rg.Height) 778 | shp.OnAction = "MoveNew" 779 | shp.OLEFormat.Object.Text = "*" 780 | End If 781 | 782 | If Me.chkCreateControlButtons Or Me.chkCreateNavigationButtons Then 783 | 'Copy sheet modulce code and basControlButtons code 784 | With dobjClipboard 785 | .SetText Me.txtButtonsCode.Text 786 | .PutInClipboard 787 | 'Warn the user how to paste button codes on sheet module 788 | strMsg = "To create the database buttons code, select the worksheet code module " 789 | strMsg = strMsg & "place the text cursor behind the 'Option Explicit' instruction " 790 | strMsg = strMsg & "and press Ctrl+V to paste!" 791 | MsgBox strMsg, vbInformation, "WANING: How to create buttons code!" 792 | End With 793 | End If 794 | End Sub 795 | 796 | Public Sub DeleteDatabaseButtons() 797 | Dim shp As Shape 798 | 799 | For Each shp In ActiveSheet.Shapes 800 | If shp.Type = msoFormControl Then 801 | If shp.FormControlType = xlButtonControl Then 802 | shp.Delete 803 | End If 804 | End If 805 | Next 806 | End Sub 807 | 808 | 809 | -------------------------------------------------------------------------------- /Ch08/frmDBProperties.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/frmDBProperties.frx -------------------------------------------------------------------------------- /Ch08/frmDBProperties.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch08/frmDBProperties.xlsm -------------------------------------------------------------------------------- /Ch09/USDA Food Composer_SheetDBEngineManageAutomation.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch09/USDA Food Composer_SheetDBEngineManageAutomation.xlsm -------------------------------------------------------------------------------- /Ch09/USDA Food Composer_SheetDBEngineManageAutomation1.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch09/USDA Food Composer_SheetDBEngineManageAutomation1.xlsm -------------------------------------------------------------------------------- /Ch09/USDA Food Composer_SheetDBEngineManageCopyPasteRecords.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch09/USDA Food Composer_SheetDBEngineManageCopyPasteRecords.xlsm -------------------------------------------------------------------------------- /Ch09/USDA Food Composer_SheetDBEnginebasUSDA.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch09/USDA Food Composer_SheetDBEnginebasUSDA.xlsm -------------------------------------------------------------------------------- /Ch09/USDA Food Composer_SheetDBEnginefrmUSDA.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch09/USDA Food Composer_SheetDBEnginefrmUSDA.xlsm -------------------------------------------------------------------------------- /Ch10/Apple.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/Apple.bmp -------------------------------------------------------------------------------- /Ch10/Caju.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/Caju.bmp -------------------------------------------------------------------------------- /Ch10/CloseButton.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/CloseButton.bmp -------------------------------------------------------------------------------- /Ch10/Donut.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/Donut.bmp -------------------------------------------------------------------------------- /Ch10/Timer class.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/Timer class.xlsm -------------------------------------------------------------------------------- /Ch10/USDA Food Composer_frmAbout.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/USDA Food Composer_frmAbout.xlsm -------------------------------------------------------------------------------- /Ch10/UserForm_APIs.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch10/UserForm_APIs.xlsm -------------------------------------------------------------------------------- /Ch11/USDA Food Composer_RibbonX.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/Ch11/USDA Food Composer_RibbonX.xlsm -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Apress/programming-excel-w-vba/d6f8c0d31b9a735a99091b041d4bc8d60949c39b/LICENSE.txt -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Apress Source Code 2 | 3 | This repository accompanies [*Programming Excel with VBA*](http://www.apress.com/9781484222041) by Flavio Morgado (Apress, 2016). 4 | 5 | ![Cover image](9781484222041.jpg) 6 | 7 | Download the files as a zip using the green button, or clone the repository to your machine using Git. 8 | 9 | ## Releases 10 | 11 | Release v1.0 corresponds to the code in the published book, without corrections or updates. 12 | 13 | ## Contributions 14 | 15 | See the file Contributing.md for more information on how you can contribute to this repository. 16 | -------------------------------------------------------------------------------- /contributing.md: -------------------------------------------------------------------------------- 1 | # Contributing to Apress Source Code 2 | 3 | Copyright for Apress source code belongs to the author(s). However, under fair use you are encouraged to fork and contribute minor corrections and updates for the benefit of the author(s) and other readers. 4 | 5 | ## How to Contribute 6 | 7 | 1. Make sure you have a GitHub account. 8 | 2. Fork the repository for the relevant book. 9 | 3. Create a new branch on which to make your change, e.g. 10 | `git checkout -b my_code_contribution` 11 | 4. Commit your change. Include a commit message describing the correction. Please note that if your commit message is not clear, the correction will not be accepted. 12 | 5. Submit a pull request. 13 | 14 | Thank you for your contribution! --------------------------------------------------------------------------------