├── .gitattributes ├── .gitignore ├── LICENSE ├── readme.md ├── resources ├── Budget │ ├── Budget template.xlsx │ ├── Family budget (monthly).xlsx │ ├── Monthly Budget accessibility guide1.xlsx │ ├── Personal budget.xlsx │ └── Personal expenses calculator1.xlsx ├── Other Examples │ ├── Calendar5.2.xlsm │ ├── ComboBox1ereLettre-3.xls │ ├── Couleurs.xlsm │ ├── DVPremieresLettres-2.xls │ ├── DropdownList.xlsm │ ├── Dynamic-Pareto-Chart1.xlsx │ ├── Planning │ │ ├── Date au double clic.xls │ │ ├── EventDate4.xlsm │ │ ├── Excel-Leave-Tracker.xlsm │ │ ├── Planning excel v1.9_bak.xlsm │ │ ├── Shared-Expense-Calculator.xlsx │ │ ├── TimeSheet-Calculator.xlsx │ │ └── Vacation-Packing-List.xlsm │ └── To Do list │ │ ├── To-Do-List-Template-Double-Click.xlsm │ │ └── To-Do-List-Template.xlsm └── RegEx dual screen v2010 │ ├── ddeexec.reg │ ├── readme.md │ └── shellsheet open.reg └── src ├── BlueCalendar.bas ├── Cells_With_Formula.bas ├── Create_calendar.bas ├── CustomInsert.bas ├── DropDown.bas ├── History.bas ├── Matrix.bas ├── RowColumnLoop.bas ├── Userform.bas ├── colors.bas ├── delete_row.bas └── simple_examples.bas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Windows image file caches 2 | Thumbs.db 3 | ehthumbs.db 4 | 5 | # Folder config file 6 | Desktop.ini 7 | 8 | # Recycle Bin used on file shares 9 | $RECYCLE.BIN/ 10 | 11 | # Windows Installer files 12 | *.cab 13 | *.msi 14 | *.msm 15 | *.msp 16 | 17 | # Windows shortcuts 18 | *.lnk 19 | 20 | #XML files 21 | *.xml 22 | 23 | # ========================= 24 | # Operating System Files 25 | # ========================= 26 | 27 | # OSX 28 | # ========================= 29 | 30 | .DS_Store 31 | .AppleDouble 32 | .LSOverride 33 | 34 | # Thumbnails 35 | ._* 36 | 37 | # Files that might appear in the root of a volume 38 | .DocumentRevisions-V100 39 | .fseventsd 40 | .Spotlight-V100 41 | .TemporaryItems 42 | .Trashes 43 | .VolumeIcon.icns 44 | 45 | # Directories potentially created on remote AFP share 46 | .AppleDB 47 | .AppleDesktop 48 | Network Trash Folder 49 | Temporary Items 50 | .apdisk 51 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright 2018 Sylhare 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Excel VBA 2 | 3 | In excel, you have to enable first the macro (and select the developper option). 4 | Then you can press ALT + F11 to go into edit macro mode. 5 | To learn you can start with "recording macro" to see what excel is recording, but it's not the most efficient way. 6 | 7 | You can copy / paste the files `.bas` in the `src` folder inside the macro editor (VBS) to execute them. 8 | 9 | #### Sources 10 | 11 | - Microsoft Excel 2010: [getting started](https://msdn.microsoft.com/fr-fr/library/office/ee814737(v=office.14).aspx) 12 | 13 | 14 | ##### French Tips 15 | 16 | - [Excel plus: VBA tips](http://www.excel-plus.fr/category/vba/) 17 | - [Excel pratique VBA tips](https://www.excel-pratique.com/) 18 | - [Developpez.com outlook vba](http://dolphy35.developpez.com/article/outlook/vba/#LV-A) 19 | 20 | 21 | ##### English Tips 22 | 23 | - [Ozgrid excel vb tutorial](http://www.ozgrid.com/Excel/free-training/ExcelVBA1/excel-vba1-index.htm) 24 | - [Excel easy: vba macro](http://www.excel-easy.com/vba.html) 25 | - [Tutorialspoint VBA](https://www.tutorialspoint.com/vba/index.htm) 26 | - [Rondebruin mail with outlook](http://www.rondebruin.nl/win/s1/outlook/mail.htm) 27 | - [Extend Office: AutoComplete](https://www.extendoffice.com/documents/excel/2401-excel-drop-down-list-autocomplete.html) 28 | - [Convert data type vb](http://www.convertdatatypes.com/Language-VB6-VBA.html) 29 | 30 | 31 | ## Excel autofind drop down menu 32 | 33 | Find out the detail tutorial on how to do it here: 34 | 35 | - [How to create a dropdown search menu from an excel spreadsheet](https://sylhare.github.io/2015/02/15/Excel-autofind-dropdown-menu.html) 36 | 37 | 38 | ## Other tips 39 | 40 | You can find everything on my blog at: 41 | 42 | - [Excel Macro tips](https://sylhare.github.io/2015/04/17/Excel-macro-tips.html) 43 | 44 | #### Comment / Uncomment bloc of code 45 | 46 | There's a Comment / Uncomment button that can be toggled. For that **right click** on the **menu bar** then click on **edit**, the edit tool bar will appear (you can place it in your quick access bar). There should be a **comment** and **Uncomment** **icon**. This commands will basically add or remove `'` at the beginning of every selected ligns. 47 | 48 | #### Calling a Sub 49 | 50 | Here are an example on how to call a subroutine: [here](https://msdn.microsoft.com/en-us/library/office/gg251432.aspx) 51 | It can be tricky. 52 | ```vb 53 | Test "N23:Q23", 1 54 | Call Test("N23:Q23", 1) 55 | 56 | 57 | Sub Test(xRange As Range, val As Integer) 58 | 'some coding 59 | End Sub 60 | ``` 61 | 62 | 63 | #### Accelerate Macro 64 | 65 | Here are a couple of lines that can greatly improve the efficiency of your VBA macro. 66 | 67 | ```vb 68 | Sub example() 69 | 'Stop automatic calculation of excel cells 70 | Application.Calculation = xlCalculationManual 71 | 'Stop screen updating 72 | Application.ScreenUpdating = False 73 | 74 | 'Some code 75 | 76 | 'Put it back to "normal" 77 | Application.Calculation = xlCalculationAutomatic 78 | Application.ScreenUpdating = True 79 | End Sub 80 | ``` 81 | 82 | #### Hide "0" value of empty cells 83 | 84 | Sometime there are some 0 that pops up with the below formulas, so here is a trick to hide them through formating. 85 | Available [here](https://support.office.com/en-us/article/Display-or-hide-zero-values-3ec7a433-46b8-4516-8085-a00e9e476b03): 86 | 87 | - Home > Format > Format Cells 88 | - Number > Custom 89 | - type : `0;;;@` 90 | 91 | #### Userform 92 | Some example for the Userform 93 | 94 | ```vb 95 | Userform 96 | Textbox 97 | Multiline : True 98 | EnterKeyBehavior = True (sinon ctrl + Enter) 99 | ``` 100 | 101 | 102 | #### Closing procedure 103 | Procedure to close a file 104 | 105 | ```vb 106 | Sub arret() 107 | 'stop the current sub 108 | ActiveWorkbook.Save 109 | ActiveWorkbook.Close True 110 | End Sub 111 | ``` 112 | 113 | Close the file after 10 seconds 114 | 115 | ```vb 116 | Private Sub Workbook_Open() 117 | temp = Now + TimeValue(« 00:00:10 ») 118 | Application.OnTime temp, « arret » 119 | End Sub 120 | ``` 121 | -------------------------------------------------------------------------------- /resources/Budget/Budget template.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Budget/Budget template.xlsx -------------------------------------------------------------------------------- /resources/Budget/Family budget (monthly).xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Budget/Family budget (monthly).xlsx -------------------------------------------------------------------------------- /resources/Budget/Monthly Budget accessibility guide1.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Budget/Monthly Budget accessibility guide1.xlsx -------------------------------------------------------------------------------- /resources/Budget/Personal budget.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Budget/Personal budget.xlsx -------------------------------------------------------------------------------- /resources/Budget/Personal expenses calculator1.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Budget/Personal expenses calculator1.xlsx -------------------------------------------------------------------------------- /resources/Other Examples/Calendar5.2.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Calendar5.2.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/ComboBox1ereLettre-3.xls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/ComboBox1ereLettre-3.xls -------------------------------------------------------------------------------- /resources/Other Examples/Couleurs.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Couleurs.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/DVPremieresLettres-2.xls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/DVPremieresLettres-2.xls -------------------------------------------------------------------------------- /resources/Other Examples/DropdownList.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/DropdownList.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/Dynamic-Pareto-Chart1.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Dynamic-Pareto-Chart1.xlsx -------------------------------------------------------------------------------- /resources/Other Examples/Planning/Date au double clic.xls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/Date au double clic.xls -------------------------------------------------------------------------------- /resources/Other Examples/Planning/EventDate4.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/EventDate4.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/Planning/Excel-Leave-Tracker.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/Excel-Leave-Tracker.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/Planning/Planning excel v1.9_bak.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/Planning excel v1.9_bak.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/Planning/Shared-Expense-Calculator.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/Shared-Expense-Calculator.xlsx -------------------------------------------------------------------------------- /resources/Other Examples/Planning/TimeSheet-Calculator.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/TimeSheet-Calculator.xlsx -------------------------------------------------------------------------------- /resources/Other Examples/Planning/Vacation-Packing-List.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/Planning/Vacation-Packing-List.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/To Do list/To-Do-List-Template-Double-Click.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/To Do list/To-Do-List-Template-Double-Click.xlsm -------------------------------------------------------------------------------- /resources/Other Examples/To Do list/To-Do-List-Template.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/Other Examples/To Do list/To-Do-List-Template.xlsm -------------------------------------------------------------------------------- /resources/RegEx dual screen v2010/ddeexec.reg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/RegEx dual screen v2010/ddeexec.reg -------------------------------------------------------------------------------- /resources/RegEx dual screen v2010/readme.md: -------------------------------------------------------------------------------- 1 | ## Excel Split Screen 2 | 3 | Modifier les clées de registres comme suit : 4 | 5 | - Appuyez sur `[Windows]+[R]`, saisissez `REGEDIT` et cliquez sur `OK` 6 | 7 | ### Première séquence 8 | 9 | - Déployez la clé `HKEY_CLASSES_ROOT \ Excel.Sheet.12 \ Shell \ Open` 10 | - Supprimez la clé `DDEEXEC` en cliquant dessus du bouton droit et en choisissant `Supprimer` 11 | - Entrez dans clé `COMMAND` 12 | - Remarquez la présence d'une valeur `(par défaut)` et d'une valeur `command` 13 | - Cliquez du bouton droit sur la valeur `command` et choisissez `Supprimer` 14 | - Double-cliquez sur la valeur `(par défaut)` 15 | - Ajoutez un espace puis `%1` (avec les guillemets) en fin de ligne pour que la donnée ressemble à: 16 | ```bat 17 | C:\Program Files\Microsoft Office\Office12\EXCEL.EXE" /e "%1" 18 | ``` 19 | 20 | ### Deuxième séquence 21 | 22 | - Déployez la clé `HKEY_CLASSES_ROOT \ Excel.Sheet.8 \ Shell \ Open` 23 | - Supprimez la clé `DDEEXEC` en cliquant dessus du bouton droit et en choisissant `Supprimer` 24 | - Entrez dans clé `COMMAND` 25 | - Remarquez la présence d'une valeur `(par défaut)` et d'une valeur `command` 26 | - Cliquez du bouton droit sur la valeur "command" et choisissez Supprimer 27 | - Double-cliquez sur la valeur `(par défaut)` 28 | - Ajoutez un espace puis `%1` (avec les guillemets) en fin de ligne pour que la donnée ressemble à: 29 | ```bat 30 | "C:\Program Files\Microsoft Office\Office12\EXCEL.EXE" /e "%1" 31 | ``` 32 | 33 | ### Finalement 34 | 35 | - Fermez `REGEDIT` 36 | 37 | Maintenant, si vous double-cliquez sur deux fichiers XLS ou XSLX sur le bureau ou l'explorateur, ils s'ouvriront bien dans deux fenêtres différentes. 38 | -------------------------------------------------------------------------------- /resources/RegEx dual screen v2010/shellsheet open.reg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sylhare/Excel_VBA/ac5a52f741edfab3e75bf0a0500bad8767c12f9d/resources/RegEx dual screen v2010/shellsheet open.reg -------------------------------------------------------------------------------- /src/BlueCalendar.bas: -------------------------------------------------------------------------------- 1 | Sub create_BlueCalendar() 2 | 3 | 'For time efficiency (Hide changes on screen) 4 | Application.Calculation = xlCalculationManual 5 | Application.ScreenUpdating = False 6 | 7 | 'c and cTemp = column, r = row, m = month, j = day, nbJour = number of days in a month 8 | Dim c As Integer, cTemp As Integer, r As Integer, k As Integer 9 | Dim dYear As Integer, m As Integer, j As Integer, nbJour As Integer, wDays As Integer 10 | Dim dayOff(1 To 12) As Date, d As Date, d1 As Date, d2 As Date 11 | 12 | 'Entrée de l'année 13 | If (Cells(1, 1).Value <> "") Then 14 | dYear = Cells(1, 1).Value 15 | Else 16 | dYear = 2015 17 | End If 18 | 19 | 'Initialisation - Cleaning 20 | r = 2 21 | cTemp = 3 22 | d1 = DateSerial(dYear, 1, 8) - Weekday(DateSerial(dYear, 1, 8) - 2) 23 | d2 = DateSerial(dYear + 1, 1, 8) - Weekday(DateSerial(dYear + 1, 1, 8) - 2) 24 | wDays = DateDiff("w", d1, d2, vbMonday, vbFirstFullWeek) * 5 25 | 26 | initClear 27 | Call formatWeeks(wDays + r) 28 | Call formatMonths(wDays + r) 29 | Call DayOffs(dYear, dayOff()) 30 | Cells(1, 1).Value = dYear 31 | 32 | 'Calendar Creation and format 33 | For m = 1 To 12 34 | nbJour = Day((DateSerial(dYear, m + 1, 1) - 1)) 35 | j = 1 36 | c = cTemp 37 | 38 | While j <= nbJour 39 | d = DateSerial(dYear, m, j) 40 | 41 | 'vbMonday -> lundi premier jour de la semaine 42 | If Weekday(d, vbMonday) = 1 Then 43 | 44 | 'Write the week days 45 | With Range(Cells(3, cTemp), Cells(3, cTemp + 4)) 46 | .Merge 47 | .Value = Format(d, "dd") + "-" + Format(d + 4, "dd") 48 | End With 49 | 50 | 'Black borders of the weeks 51 | With Range(Cells(3, cTemp), Cells(100, cTemp + 4)) 52 | .Borders(xlEdgeLeft).Weight = xlMedium 53 | .Borders(xlEdgeRight).Weight = xlMedium 54 | End With 55 | 56 | cTemp = cTemp + 5 57 | 58 | End If 59 | 60 | j = j + 1 61 | 62 | Wend 63 | 64 | r = cTemp - 1 65 | 66 | 'Write Months 67 | With Range(Cells(2, c), Cells(2, r)) 68 | .Merge 69 | .Value = Format(d, "mmm. yyyy") 70 | End With 71 | Next m 72 | 73 | 'To set it back to normal 74 | Application.Calculation = xlCalculationAutomatic 75 | Application.ScreenUpdating = True 76 | 77 | End Sub 78 | 79 | Function initClear() 80 | 'Clear everything before doing the calendar 81 | 82 | Columns("B:B").EntireColumn.Hidden = True 83 | Columns("C:NJ").ColumnWidth = 0.42 84 | Range("C3:NJ150").RowHeight = 10 85 | Cells.ClearContents 86 | Cells.Borders.LineStyle = xlNone 87 | Range("C1:NJ150").UnMerge 88 | Range("C1:NJ150").Interior.ColorIndex = none 89 | 90 | End Function 91 | 92 | Function formatWeeks(r As Integer) 93 | 94 | 'Format Weeks 95 | With Range(Cells(3, 3), Cells(3, r)) 96 | .HorizontalAlignment = xlCenter 97 | .VerticalAlignment = xlCenter 98 | .NumberFormat = "@" 99 | .Font.Size = 7 100 | .ReadingOrder = xlContext 101 | .Font.ThemeColor = xlThemeColorDark1 102 | .Font.Name = "Arial" 103 | .Interior.Color = 16711680 104 | End With 105 | 106 | End Function 107 | 108 | Function formatMonths(r As Integer) 109 | 110 | 'Format Months 111 | With Range(Cells(2, 3), Cells(2, r)) 112 | .HorizontalAlignment = xlCenter 113 | .VerticalAlignment = xlCenter 114 | .RowHeight = 22.5 115 | .Interior.Color = 16711680 116 | .Font.ThemeColor = xlThemeColorDark1 117 | .Font.Bold = True 118 | .Font.Name = "Arial" 119 | .Borders.Weight = xlMedium 120 | End With 121 | 122 | End Function 123 | 124 | Sub Browsing() 125 | 126 | Dim dYear As Integer, i As Integer, d1 As Date, d2 As Date, m As Integer 127 | Dim nbJour As Integer, k As Integer 128 | Dim workDays(1 To 300) As Date 129 | Dim dayOff(1 To 12) As Date 130 | 131 | Rows("4:4").ClearContents 132 | 133 | dYear = 2015 134 | k = DayOffs(dYear, dayOff()) 135 | 136 | 'nbJour = Day((DateSerial(dYear, m + 1, 1) - 1)) 137 | 'd1 commence au premier lundi de l'année 138 | d1 = DateSerial(dYear, 1, 8) - Weekday(DateSerial(dYear, 1, 8) - 2) 139 | d2 = DateSerial(dYear + 1, 1, 8) - Weekday(DateSerial(dYear + 1, 1, 8) - 2) 140 | 141 | k = 0 142 | i = 1 143 | 144 | 'Cells(4, 1) = DateDiff("w", d1, d2, vbMonday, vbFirstFullWeek) * 5 145 | 146 | While (d1 + k) < d2 147 | 148 | 'Pas un weekend 149 | If Weekday(d1 + k, vbMonday) <= 5 Then 150 | workDays(i) = d1 + k 151 | Cells(4, i + 2).Value = d1 + k 152 | m = Month(d1 + k) 153 | If ((d1 + k) = DayOffs(m)) Then 154 | Cells(4, i + 2).Interior.ColorIndex = 40 155 | End If 156 | 157 | i = i + 1 158 | End If 159 | 160 | k = k + 1 161 | Wend 162 | 163 | End Sub 164 | 165 | Function DayOffs(dYear As Integer, dayOff() As Date) 166 | 'Initialisation Off Days 167 | Dim a As Integer 168 | 169 | '1st January 170 | dayOff(1) = DateSerial(dYear, 1, 1) 171 | '2 172 | dayOff(2) = DateSerial(1900, 1, 1) 173 | '3 174 | dayOff(3) = DateSerial(1900, 1, 1) 175 | 'Easter Monday until 2099 '"\" means "/" with integer rest 176 | a = (204 - 11 * (dYear Mod 19)) Mod 30 + 22 177 | dayOff(4) = DateSerial(dYear, 3, a + 6 + (a > 49) - (dYear + dYear \ 4 + a + (a > 49)) Mod 7) + 1 178 | 'Patriots National Day 179 | If (((DateSerial(dYear, 5, 7) - (DateSerial(dYear, 7, 1) - 2) Mod 7)) < DateSerial(dYear, 5, 4)) Then 180 | dayOff(5) = DateSerial(dYear, 5, 28) - (DateSerial(dYear, 5, 7) - 2) Mod 7 181 | Else 182 | dayOff(5) = DateSerial(dYear, 5, 21) - (DateSerial(dYear, 5, 7) - 2) Mod 7 183 | End If 184 | 'Quebec Day 185 | dayOff(6) = DateSerial(dYear, 6, 24) 186 | 'Canada Day 187 | If Weekday(DateSerial(dYear, 7, 1), vbMonday) = 7 Then 188 | dayOff(7) = DateSerial(dYear, 7, 2) 189 | Else 190 | dayOff(7) = DateSerial(dYear, 7, 1) 191 | End If 192 | '8 193 | dayOff(8) = DateSerial(1900, 1, 1) 194 | 'Work day 195 | dayOff(9) = DateSerial(dYear, 9, 7) - (DateSerial(dYear, 9, 7) - 2) Mod 7 196 | 'grace action 197 | dayOff(10) = DateSerial(dYear, 10, 14) - (DateSerial(dYear, 10, 7) - 2) Mod 7 198 | '11 199 | dayOff(11) = DateSerial(1900, 1, 1) 200 | 'Christmas 201 | dayOff(12) = DateSerial(dYear, 12, 25) 202 | 203 | End Function 204 | 205 | Function firstJanMon(dYear As Integer, d As Date) 206 | 207 | '8 -> première répétition. Weekday renvoi le "numéro de série du jour" (Dimanche = 1, lundi = 2, à samedi = 7) 208 | 'Pour Obtenir le premier lundi, il faut obtenir le numéro de série du lundi : 2 pour la première semaine. 8-6=2 donc 6 janvier. Pour mardi : 3 -> 8-5=3 donc 5 janvier. Pour Samedi : 7 -> 8-7=1 d'où le 8 janvier. 209 | 'weekdays fait le modulo et renvoie entre 1(Dimanche) et 7(Samedi). Le lundi (2) Première apparition du lundi dans les 8 jours 210 | Cells(17, 1).Value = Format(DateSerial(dYear, 1, 8) - Weekday(DateSerial(dYear, 1, 8) - 2), "dd/mm/yy") 211 | 212 | 'On prend le numéro de série du 7 janvier moins ce numéro de série - 2 (Pour le lundi) modulo 7 pour obtenir le premier de la semaine 213 | 'On prend pour point de référence le 7 janvier de la même année – obtenu grâce à la formule date(annee(A2);1; 7) – auquel on ôte 2 (le code du lundi). On prend le modulo par 7 de cette valeur, ce qui représente le nombre de jours qu’il faut ôter au 7 janvier pour tomber sur le premier lundi. 214 | d = DateSerial(dYear, 1, 7) - (DateSerial(dYear, 1, 7) - 2) Mod 7 215 | 216 | End Function 217 | 218 | -------------------------------------------------------------------------------- /src/Cells_With_Formula.bas: -------------------------------------------------------------------------------- 1 | 'Source: http://www.exceltrick.com/how_to/find-cells-containing-formulas-in-excel/ 2 | 3 | Sub FindFormulaCells() 4 | For Each cell In ActiveSheet.UsedRange 5 | If cell.HasFormula() = True Then 6 | cell.Interior.ColorIndex = 24 7 | End If 8 | Next cell 9 | End Sub -------------------------------------------------------------------------------- /src/Create_calendar.bas: -------------------------------------------------------------------------------- 1 | Sub create_Calendar() 2 | 3 | 'c and cTemp = column, r = row, m = month, j = day, nbJour = number of days in a month 4 | Dim a As Integer, c As Integer, cTemp As Integer, r As Integer, m As Integer, dYear As Integer, j As Integer, nbJour As Integer 5 | Dim dayOff(1 To 12) As Date, d As Date 6 | 7 | 'Initialisation 8 | r = 2 9 | Columns("B:B").EntireColumn.Hidden = True 10 | Range("C3:NJ3").ColumnWidth = 1 11 | Range("C3:NJ3").RowHeight = 52 12 | Range("C1:NJ15").Clear 13 | Range("C1:NJ15").UnMerge 14 | Range("C1:NJ15").Interior.ColorIndex = none 15 | 16 | With Cells(1, 1) 17 | .Value = "Année" 18 | .HorizontalAlignment = xlCenter 19 | .VerticalAlignment = xlCenter 20 | .Font.Bold = True 21 | End With 22 | 23 | 'Cells(2, 1).Value = 2015 24 | dYear = Cells(2, 1).Value 25 | 26 | 27 | Call DayOffs(dYear, dayOff()) 28 | 29 | 'Calendar Creation and format 30 | For m = 1 To 12 31 | nbJour = Day((DateSerial(dYear, m + 1, 1) - 1)) 32 | c = r + 1 33 | r = c - 1 + nbJour 34 | cTemp = c 35 | 36 | For j = 1 To nbJour 37 | d = DateSerial(dYear, m, j) 38 | 39 | With Cells(3, cTemp) 40 | .HorizontalAlignment = xlCenter 41 | .VerticalAlignment = xlBottom 42 | .Orientation = 90 43 | .ReadingOrder = xlContext 44 | .Font.Size = 8 45 | .Value = Format(d, "dd ddd") 46 | End With 47 | 48 | If Weekday(d, vbMonday) > 5 Then 49 | Cells(3, cTemp).Interior.ColorIndex = 16 50 | End If 51 | 52 | If (m <> 2 And m <> 3 And m <> 8 And m <> 11 And d = dayOff(m)) Then 53 | Cells(3, cTemp).Interior.ColorIndex = 40 54 | End If 55 | 56 | cTemp = cTemp + 1 57 | Next j 58 | 59 | 'Write & Format Month cells 60 | With Range(Cells(2, c), Cells(2, r)) 61 | .HorizontalAlignment = xlCenter 62 | .VerticalAlignment = xlCenter 63 | .Merge 64 | .Value = Format(d, "mmmm") 65 | .Font.Bold = True 66 | End With 67 | 68 | Next m 69 | 70 | End Sub 71 | 72 | Function DayOffs(dYear As Integer, dayOff() As Date) 73 | 'Initialisation Off Days 74 | Dim a As Integer 75 | 76 | '1st January 77 | dayOff(1) = DateSerial(dYear, 1, 1) 78 | '2 79 | dayOff(2) = DateSerial(1900, 1, 1) 80 | '3 81 | dayOff(3) = DateSerial(1900, 1, 1) 82 | 'Easter Monday until 2099 '"\" means "/" with integer rest 83 | a = (204 - 11 * (dYear Mod 19)) Mod 30 + 22 84 | dayOff(4) = DateSerial(dYear, 3, a + 6 + (a > 49) - (dYear + dYear \ 4 + a + (a > 49)) Mod 7) + 1 85 | 'Patriots National Day 86 | If (((DateSerial(dYear, 5, 7) - (DateSerial(dYear, 7, 1) - 2) Mod 7)) < DateSerial(dYear, 5, 4)) Then 87 | dayOff(5) = DateSerial(dYear, 5, 28) - (DateSerial(dYear, 5, 7) - 2) Mod 7 88 | Else 89 | dayOff(5) = DateSerial(dYear, 5, 21) - (DateSerial(dYear, 5, 7) - 2) Mod 7 90 | End If 91 | 'Quebec Day 92 | dayOff(6) = DateSerial(dYear, 6, 24) 93 | 'Canada Day 94 | If Weekday(DateSerial(dYear, 7, 1), vbMonday) = 7 Then 95 | dayOff(7) = DateSerial(dYear, 7, 2) 96 | Else 97 | dayOff(7) = DateSerial(dYear, 7, 1) 98 | End If 99 | '8 100 | dayOff(8) = DateSerial(1900, 1, 1) 101 | 'Work day 102 | dayOff(9) = DateSerial(dYear, 9, 7) - (DateSerial(dYear, 9, 7) - 2) Mod 7 103 | 'grace action 104 | dayOff(10) = DateSerial(dYear, 10, 14) - (DateSerial(dYear, 10, 7) - 2) Mod 7 105 | '11 106 | dayOff(11) = DateSerial(1900, 1, 1) 107 | 'Christmas 108 | dayOff(12) = DateSerial(dYear, 12, 25) 109 | 110 | End Function 111 | 112 | -------------------------------------------------------------------------------- /src/CustomInsert.bas: -------------------------------------------------------------------------------- 1 | Sub CustomInsert() 2 | 'Click on a cell and launch the macro to insert a custom new line, 3 | 'Clearing all sells that has no formula but the x first rows specified with info variable 4 | Dim wks As Worksheet 5 | Dim colrange As Range 6 | Dim LastCol As Long 7 | Dim info As Integer 8 | 9 | Application.Calculation = xlCalculationManual 10 | Application.ScreenUpdating = False 11 | 12 | 'The "info" col umns mark the first column to be kept when copied 13 | info = 7 14 | 15 | 'Check last populated column and copy/insert a new one below active cell 16 | Set wks = ActiveSheet 17 | LastCol = wks.Cells(1, wks.Columns.Count).End(xlToLeft).Column 18 | Set colrange = wks.Range(wks.Cells(ActiveCell.row, info), wks.Cells(ActiveCell.row, LastCol)) 19 | 20 | ActiveCell.Rows("1:1").EntireRow.Select 21 | Selection.Copy 22 | Selection.Insert Shift:=xlDown 23 | Application.CutCopyMode = False 24 | 25 | 'Clearing all but formulas and info 26 | For Each cell In colrange 27 | If cell.HasFormula() = False Then 28 | cell.ClearContents 29 | End If 30 | Next cell 31 | 32 | Application.Calculation = xlCalculationAutomatic 33 | Application.ScreenUpdating = True 34 | End Sub -------------------------------------------------------------------------------- /src/DropDown.bas: -------------------------------------------------------------------------------- 1 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) 2 | 'Hide the combobox when not called and place it top of the sheet 3 | Dim combo As OLEObject 4 | Dim wks As Worksheet 5 | Set wks = Application.ActiveSheet 6 | On Error Resume Next 7 | Application.EnableEvents = False 8 | Application.ScreenUpdating = True 9 | 10 | 'Name of the dropdown (ComboBox) list from the developer tab, it's the default name 11 | Set combo = wks.OLEObjects("ComboBox1") 12 | 13 | With combo 14 | .Top = 10 15 | .Left = 10 16 | .Visible = False 17 | .Value = "" 18 | End With 19 | Application.EnableEvents = True 20 | 21 | End Sub 22 | 23 | Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 24 | 'Activate the ComboBox when doubleClicking on a cell that has a data validator (Data >Data validation) 25 | 'It has been customised with J2 the linked cell to make custom search with formulas 26 | 'Otherwise .LinkedCell = Target.Address can be use to modify the clicked cell 27 | Dim dropRange As String 28 | Dim combo As OLEObject 29 | Dim wks As Worksheet 30 | Set wks = Application.ActiveSheet 31 | On Error Resume Next 32 | Application.EnableEvents = False 33 | 34 | Set combo = wks.OLEObjects("ComboBox1") 35 | 36 | 'Define which search page to look for when using the drop for two different columns in the same page 37 | 'Set the searching cell when doube clicking on column A 38 | If Not Intersect(Target, Range("A:A")) Is Nothing Then 39 | With combo 40 | .LinkedCell = "search!$J$2" 41 | .Visible = False 42 | End With 43 | End If 44 | 45 | 'Set the searching cell when doube clicking on column H 46 | If Not Intersect(Target, Range("H:H")) Is Nothing Then 47 | With combo 48 | .LinkedCell = "search!$J$5" 49 | .Visible = False 50 | End With 51 | End If 52 | 53 | If Target.Validation.Type = 3 Then 54 | Cancel = True 55 | 56 | 'Define the value of the range, based on data validation of the target cell 57 | dropRange = Target.Validation.Formula1 58 | dropRange = Right(dropRange, Len(dropRange) - 1) 59 | 60 | 'The ComboBox appear when there is a data validation on the cell 61 | If dropRange <> "" Then 62 | With combo 63 | .Visible = True 64 | .Left = Target.Left - 1 65 | .Top = Target.Top - 1 66 | .Width = Target.Width + 15 67 | .Height = Target.Height + 1 68 | .ListFillRange = dropRange 69 | End With 70 | 71 | combo.Activate 72 | Me.ComboBox1.DropDown 73 | End If 74 | End If 75 | 76 | Application.EnableEvents = True 77 | 78 | End Sub 79 | 80 | Private Sub ComboBox1_KeyDown(ByVal _ 81 | KeyCode As MSForms.ReturnInteger, _ 82 | ByVal Shift As Integer) 83 | 'Define the behaviour of the comboBox named "ComboBox1" when key is touched 84 | 'Modified to work with one "searching" case linked to the ComboBox which value will be copied to the activeCell 85 | Dim value As String 86 | 87 | If Worksheets("search").Range("$J$2").value <> "" Then 88 | value = Worksheets("search").Range("$J$2").value 89 | Else 90 | value = Worksheets("search").Range("$J$5").value 91 | End If 92 | 93 | Select Case KeyCode 94 | Case 9 'Tab key 95 | ActiveCell.Value = Worksheets("search").Range("$J$2").Value 96 | ActiveCell.Offset(0, 1).Activate 97 | Case 13 'Enter key 98 | ActiveCell.Value = Worksheets("search").Range("$J$2").Value 99 | ActiveCell.Offset(1, 0).Activate 100 | Case 37 'Left Arrow key 101 | ActiveCell.Offset(0, -1).Activate 102 | Case 39 'Right arrow key 103 | ActiveCell.Offset(0, 1).Activate 104 | Case Else 105 | 'do nothing 106 | End Select 107 | 108 | End Sub 109 | -------------------------------------------------------------------------------- /src/History.bas: -------------------------------------------------------------------------------- 1 | Sub History() 2 | 3 | Dim i As Integer 4 | 5 | i = 3 6 | 7 | If MsgBox("Irreversible Operation:" & vbCrLf & "Are you sure ?", vbQuestion + vbYesNo, "Saving ...") = vbYes Then 8 | While (Cells(i, 3).Value <> "") 9 | 10 | If (Cells(i, 5) <> "" And (Cells(i, 7).Value <> "Closed" Or Cells(i, 7).Value <> "TBD")) Then 11 | Cells(i, 5 + 22).Value = Date & ": " & Cells(i, 5).Value & vbCrLf & Cells(i, 5 + 22).Value 12 | Cells(i, 5).RowHeight = 13 13 | Cells(i, 5).Value = "" 14 | End If 15 | 16 | i = i + 1 17 | Wend 18 | 19 | End If 20 | 21 | End Sub 22 | 23 | ------------------- 24 | 25 | Sub History() 26 | 27 | Dim i As Integer, notes As Integer 28 | 29 | notes = 9 30 | i = 4 31 | 32 | While (Cells(i, 8).Value <> "") 33 | If (Cells(i, notes) <> "") Then 34 | Cells(i, notes + 1).Value = Date & ": " & Cells(i, notes).Value & vbCrLf & Cells(i, notes + 1).Value 35 | Cells(i, notes).RowHeight = 13 36 | Cells(i, notes).Value = "" 37 | End If 38 | 39 | i = i + 1 40 | Wend 41 | 42 | ActiveWorkbook.Save 43 | 44 | End Sub 45 | 46 | 47 | --------------- 48 | 49 | 50 | Sub History() 51 | 52 | Dim i As Integer 53 | 54 | i = 2 55 | 56 | While (Cells(i, 3).Value <> "") 57 | 58 | If (Cells(i, 5) <> "") Then 59 | Cells(i, 6).Value = Date & ": " & Cells(i, 5).Value & vbCrLf & Cells(i, 6).Value 60 | 'Cells(i, 5).RowHeight = 13 61 | Cells(i, 5).Value = "" 62 | End If 63 | 64 | i = i + 1 65 | Wend 66 | 67 | 'ActiveWorkbook.Save 68 | 69 | End Sub 70 | 71 | 72 | 73 | ------------ 74 | 75 | Sub History() 76 | 77 | Dim i As Integer 78 | 79 | i = 3 80 | 81 | If MsgBox("Irreversible Operation:" & vbCrLf & "Are you sure ?", vbQuestion + vbYesNo, "Saving ...") = vbYes Then 82 | While (Cells(i, 3).Value <> "") 83 | 84 | If (Cells(i, 5) <> "" And (Cells(i, 7).Value <> "Closed" Or Cells(i, 7).Value <> "TBD")) Then 85 | Cells(i, 5 + 21).Value = Date & ": " & Cells(i, 5).Value & vbCrLf & Cells(i, 5 + 21).Value 86 | Cells(i, 5).RowHeight = 13 87 | Cells(i, 5).Value = "" 88 | End If 89 | 90 | i = i + 1 91 | Wend 92 | 93 | 'Si oui sauvegarde le fichier 94 | ActiveWorkbook.Save 95 | End If 96 | 97 | End Sub 98 | 99 | --------------- 100 | 101 | Sub History() 102 | 103 | Dim i As Integer 104 | 105 | i = 3 106 | 107 | While (Cells(i, 3).Value <> "") 108 | 109 | If (Cells(i, 5) <> "" And (Cells(i, 7).Value <> "Closed" Or Cells(i, 7).Value <> "TBD")) Then 110 | Cells(i, 5 + 21).Value = Date & ": " & Cells(i, 5).Value & vbCrLf & Cells(i, 5 + 21).Value 111 | Cells(i, 5).RowHeight = 13 112 | Cells(i, 5).Value = "" 113 | End If 114 | 115 | i = i + 1 116 | Wend 117 | 118 | ActiveWorkbook.Save 119 | 120 | End Sub 121 | 122 | 123 | 124 | 125 | -------------------------------- 126 | 127 | Sub Save() 128 | 129 | Dim path As String 130 | 131 | path = "C:\Users\username\Documents\" & Format(Date, "yyyy") & " - " & Format(Date, "mm") 132 | file = "title " & Format(Date, "mm") & " - " & Format(Date, "dd") & ".xlsx" 133 | 134 | Application.DisplayAlerts = False 135 | ThisWorkbook.SaveAs Filename:=file, FileFormat:=51 'Save 136 | Application.DisplayAlerts = True 137 | MsgBox ("Your file has been saved") 'Info window 138 | 139 | Exit Sub 140 | 141 | End Sub 142 | 143 | 144 | Sub Clean() 145 | 146 | Dim i As Integer 147 | 148 | i = 1 149 | 150 | While (i < 201) 151 | i = i + 1 152 | If Cells(i, 1).Value = "" Then 153 | Rows(i).EntireRow.Delete 154 | End If 155 | 156 | Wend 157 | 158 | 159 | End Sub 160 | -------------------------------------------------------------------------------- /src/Matrix.bas: -------------------------------------------------------------------------------- 1 | Sub MigrateCustomerList() 2 | 3 | Dim i As Integer, j As Integer, n As Integer 4 | Dim yy As Integer, mm As Integer, d As Date, pass As Boolean 5 | 6 | yy = 2016 7 | mm = 1 8 | pass = False 9 | 10 | j = 6 'Column of result 11 | i = 2 'Row of Customer 12 | 13 | 14 | Range(Cells(nr, 1), Cells(500, 200)).ClearContents 15 | With Range(Cells(nr, 1), Cells(500, 200)).Interior 16 | .Pattern = xlNone 17 | .TintAndShade = 0 18 | .PatternTintAndShade = 0 19 | End With 20 | 21 | 22 | 'For time efficiency 23 | Application.Calculation = xlCalculationManual 24 | Application.ScreenUpdating = False 25 | 26 | AscendingSort (c + 1) 27 | 28 | For i = 2 To nb 29 | 30 | n = nr + 1 31 | If (IsDate(Cells(i, c + 1).Value) = True) Then 32 | 33 | 'Migration date 34 | mm = Month(Cells(i, c + 1).Value) 35 | yy = Year(Cells(i, c + 1).Value) 36 | d = DateSerial(yy, mm, 1) 37 | Cells(n, j).Value = Format(d, "yyyy-mmmm") 38 | Cells(n, j).Font.Bold = True 39 | 40 | 41 | 'List customer by Month of Migration date 42 | While IsDate(Cells(i, c + 1).Value) = True And pass = False 43 | If Month(Cells(i, c + 1).Value) = mm Then 44 | n = n + 1 45 | Fill i:=i, j:=j, c:=c, n:=n 46 | i = i + 1 47 | Else 48 | pass = True 49 | End If 50 | Wend 51 | i = i - 1 'Miss one with the while and the for 52 | 53 | pass = False 54 | count j:=j, n:=n 55 | Else 56 | List Condition:=Cells(i, c + 1).Value, i:=i, j:=j, c:=c, n:=n 57 | End If 58 | 59 | Next i 60 | 61 | 'Sum all the customer ready to migrate 62 | Cells(nr, 5).Value = WorksheetFunction.Sum(Range(Cells(nr, 6), Cells(nr, j - 6))) 63 | 64 | AscendingSort (c) 65 | 'ActiveWindow.SmallScroll Down:=264 66 | 67 | 'To set it back to normal 68 | Application.Calculation = xlCalculationAutomatic 69 | Application.ScreenUpdating = True 70 | 71 | End Sub 72 | 73 | Sub AscendingSort(column As Integer) 74 | 75 | ActiveWorkbook.Worksheets("Matrix").AutoFilter.Sort.SortFields. _ 76 | Clear 77 | ActiveWorkbook.Worksheets("Matrix").AutoFilter.Sort.SortFields. _ 78 | Add Key:=Range(Cells(2, column), Cells(nb, column)), SortOn:=xlSortOnValues, Order:=xlAscending, _ 79 | DataOption:=xlSortNormal 80 | With ActiveWorkbook.Worksheets("Matrix").AutoFilter.Sort 81 | .Header = xlYes 82 | .MatchCase = False 83 | .Orientation = xlTopToBottom 84 | .SortMethod = xlPinYin 85 | .Apply 86 | End With 87 | 88 | End Sub 89 | 90 | Function List(Condition As String, i As Integer, j As Integer, c As Integer, n As Integer) 91 | 92 | Cells(n, j).Font.Bold = True 93 | If Condition = "" Then 94 | Cells(n, j).Value = "Not Scheduled" 95 | Else 96 | Cells(n, j).Value = Condition 97 | End If 98 | 99 | While Cells(i, c + 1).Value = Condition 100 | n = n + 1 101 | Fill i:=i, j:=j, c:=c, n:=n 102 | i = i + 1 103 | Wend 104 | count j:=j, n:=n 105 | i = i - 1 'while and for 106 | 107 | End Function 108 | 109 | Function Fill(i As Integer, j As Integer, c As Integer, n As Integer) 110 | 111 | With Cells(n, j) 112 | .Font.Bold = False 113 | .Value = Cells(i, c).Value 114 | .Interior.Color = RGB(22, 22, 22) 115 | .Interior.TintAndShade = 0.9 116 | End With 117 | 118 | 119 | End Function 120 | 121 | 'Add the count of the results 122 | Function count(j As Integer, n As Integer) 123 | 124 | With Cells(nr, j) 125 | .Font.Bold = True 126 | .Value = n - (nr + 1) 'Count the number 127 | .NumberFormat = "General" 128 | .HorizontalAlignment = xlLeft 129 | End With 130 | j = j + 1 'New Column of result 131 | 132 | End Function 133 | 134 | Sub nb_days_month() 135 | 136 | 'Any date will do for this example 137 | date_test = CDate("6/2/2012") 138 | 139 | 'Month / Year of the date 140 | var_month = Month(date_test) 141 | var_year = Year(date_test) 142 | 143 | 'Calculation for the first day of the following month 144 | date_next_month = DateSerial(var_year, var_month + 1, 1) 145 | 146 | 'Date of the last day 147 | last_day_month = date_next_month - 1 148 | 149 | 'Number for the last day of month (= last day) 150 | nb_days = Day(last_day_month) 151 | 152 | End Sub 153 | 154 | Sub test() 155 | ' 156 | ' Macro 157 | ' 158 | With Selection.Font 159 | .Name = "Arial" 160 | .Size = 7 161 | .Strikethrough = False 162 | .Superscript = False 163 | .Subscript = False 164 | .OutlineFont = False 165 | .Shadow = False 166 | .Underline = xlUnderlineStyleNone 167 | .ThemeColor = xlThemeColorDark1 168 | .TintAndShade = 0 169 | .ThemeFont = xlThemeFontNone 170 | End With 171 | Range("CJ4").Select 172 | End Sub 173 | -------------------------------------------------------------------------------- /src/RowColumnLoop.bas: -------------------------------------------------------------------------------- 1 | Sub allColumns() 2 | 'Loop through all populated columns 3 | Dim wks As Worksheet 4 | Dim colRange As Range 5 | Dim LastCol As Long 6 | Dim count As Integer 7 | Dim msg As String 8 | 9 | ScreenUpdating = False 10 | Set wks = ActiveSheet 11 | 12 | count = 0 13 | 14 | LastCol = wks.Cells(1, wks.Columns.count).End(xlToLeft).Column 15 | 'Take the first row and all the columns 16 | Set colRange = wks.Range(wks.Cells(1, 1), wks.Cells(1, LastCol)) 17 | 18 | 'Example loop to do something to each column 19 | For Each cell In colRange 20 | count = count + 1 21 | Next cell 22 | 23 | msg = count & " " & LastCol 24 | MsgBox (msg) 25 | ScreenUpdating = True 26 | End Sub 27 | 28 | Sub allRows() 29 | 'Loop through all populated rows 30 | Dim wks As Worksheet 31 | Dim rowRange As Range 32 | Dim LastRow As Long 33 | Dim count As Integer 34 | Dim msg As String 35 | 36 | ScreenUpdating = False 37 | Set wks = ActiveSheet 38 | 39 | LastRow = wks.Cells(wks.Rows.count, "A").End(xlUp).row 40 | Set rowRange = wks.Range("A1:A" & LastRow) 41 | 42 | count = 0 43 | 44 | For Each rrow In rowRange 45 | count = count + 1 46 | Next rrow 47 | 48 | msg = count & " " & LastRow 49 | MsgBox (msg) 50 | ScreenUpdating = True 51 | End Sub 52 | 53 | Sub allRows_simple() 54 | 'Loop through all populated rows 55 | Dim wks As Worksheet 56 | Dim row As Range 57 | Dim count As Integer 58 | ScreenUpdating = False 59 | Set sheet = ActiveSheet 60 | 61 | count = 0 62 | 63 | For Each row In sheet.Rows 64 | If sheet.Cells(row.row, 1).Value = "" Then 65 | Exit For 66 | End If 67 | 68 | count = count + 1 69 | 70 | Next row 71 | 72 | MsgBox (count) 73 | ScreenUpdating = True 74 | End Sub 75 | -------------------------------------------------------------------------------- /src/Userform.bas: -------------------------------------------------------------------------------- 1 | Option Explicit 2 | 3 | 'Je te conseille de mettre la cible comme une propriete UserForm 4 | ' et de la renseigner juste avant de faire TonUserForm.Show sur le clique de la cellule 5 | Public cible As String 6 | Public nomFichier As String 7 | 8 | 'Pour ouvrir le document (par son lien hypertexte) 9 | Private Sub CommandButton1_Click() 10 | If Not FichierExiste(cible) Then 11 | MsgBox "Fichier introuvable" & vbCrLf & cible 12 | Else 13 | ThisWorkbook.FollowHyperlink cible 14 | End If 15 | End Sub 16 | 17 | Private Sub Image_Click() 18 | 19 | End Sub 20 | 21 | ' pour reprend le nom du document et afficher la photo correspondante 22 | Private Sub UserForm_Layout() 23 | 'Affichage du nom 24 | Label1.Caption = nomFichier 25 | 26 | 'Affichage de la photo 27 | Dim cheminImage As String 28 | cheminImage = ThisWorkbook.Path & "\" & nomFichier & ".jpg" 29 | 30 | If FichierExiste(cheminImage) Then 31 | Image.Picture = LoadPicture(cheminImage) 32 | End If 33 | End Sub 34 | 35 | 'Teste l'existence d'un fichier 36 | Private Function FichierExiste(filePath As String) As Boolean 37 | 'Dim fso As New FileSystemObject 38 | Dim fso As Object 39 | Set fso = CreateObject("Scripting.FileSystemObject") 40 | 41 | FichierExiste = fso.FileExists(filePath) 42 | End Function 43 | 44 | 45 | ------------------------------------------------------------------ 46 | 47 | Option Explicit 48 | 49 | 'Sur le changement de selection 50 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) 51 | If Not Intersect(Target, Me.Range("B2:B20")) Is Nothing Then 'Sur la premier colonne 52 | If Target.Value <> "" Then 'Si on a un fichier 53 | Dim cible As String 54 | 55 | 'Si on n'a pas d'hyperlien, on ne charge pas le userForm 56 | If Target.Offset(0, 1).Hyperlinks.Count = 0 Then 57 | MsgBox "Le document sur lequel vous avez cliqu顮'a pas de lien correspondant" 58 | Exit Sub 59 | End If 60 | 61 | 'On attribut la cible du lien au userForm et on l'affiche 62 | forming.nomFichier = Target.Value 63 | forming.cible = Target.Offset(0, 1).Hyperlinks(1).Address 64 | forming.Show 65 | End If 66 | End If 67 | End Sub 68 | 69 | ------------------------------------------------------------------- 70 | 71 | Sub lancer_lien_hptxt() 72 | ' lancer_lien_hptxt Macro 73 | 74 | Range("C3").Select 75 | Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 76 | End Sub -------------------------------------------------------------------------------- /src/colors.bas: -------------------------------------------------------------------------------- 1 | 'Show vb colors in Excel, with a simple loop going through the 56 ColorIndex 2 | 3 | Sub coulors() 4 | Range(« A1 »).Select 5 | For i = 1 To 56 6 | ActiveCell.Offset(0, 1).Interior.ColorIndex = ActiveCell.Value 7 | ActiveCell.Offset(1, 0).Select 8 | Next i 9 | Range(« A1 »).Select 10 | End Sub -------------------------------------------------------------------------------- /src/delete_row.bas: -------------------------------------------------------------------------------- 1 | Sub delete_row() 2 | ' 3 | ' Delete the selected row 4 | ' 5 | ActiveCell.EntireRow.Delete 6 | End Sub 7 | -------------------------------------------------------------------------------- /src/simple_examples.bas: -------------------------------------------------------------------------------- 1 | Sub EasyFct() 2 | 3 | 'MsgBox "Hello VBA World!" 4 | 'MsgBox "Entered value is " & Range("A1").Value & vbNewLine & "Test is in A1" 5 | 6 | 'Range, permet de sélectionner la/les case(s), on peut assigner 2 à la case (range(case).value): 7 | Range("B1").Value = "Range" 8 | Range("D1:D2,C4:D5").Value = 10 9 | 10 | 'Pour nommer une selection de case et leur assigner une valeur 11 | Dim example As Range 12 | Set example = Range("A3:B7") 13 | example.Value = 5 14 | 15 | 'Compter le nombre de case 16 | MsgBox "Total : " & example.Count & vbNewLine & "Lignes : " & example.Rows.Count & vbNewLine & "Colonnes : " & example.Columns.Count 17 | 18 | 19 | 'Cells permet de selectionner une case avec ses coordonnées 20 | Cells(1, 3).Value = "Cells" 21 | Range(Cells(7, 5), Cells(10, 5)).Value = "RangeCells" 22 | 23 | 'Select permet de selectionner automatiquement des cellules 24 | Dim test As Range 25 | Set test = Range("A1:F10") 26 | test.Select 27 | 'test.Rows(3).Select 'Pour selectionner une ligne 28 | 'test.Columns(2).Select 'Pour selectionner une colonne 29 | 30 | 'Pour faire un copier coller 31 | 'Range("A14:A15").Select 32 | 'selection.Copy 33 | 'Range("E1").Select 34 | 'ActiveSheet.Paste 35 | 'ou : les valeurs en A14:A15 assignées en E1:E2 36 | Range("E1:E2").Value = Range("A14:A15").Value 37 | 38 | 'Tout supprimer 39 | 'Range("A1:F10").ClearContents 40 | 'ou 41 | 'Range("A1:F10").Value = "" 42 | 43 | 'Faire des boucles 44 | Dim c As Integer, i As Integer, j As Integer 45 | 46 | For c = 1 To 3 47 | For i = 10 To 13 48 | For j = 7 To 8 49 | Worksheets(c).Cells(i, j).Value = "loop" 50 | Next j 51 | Next i 52 | Next c 53 | 54 | 'Faire un do while 55 | Do While i < 6 56 | Cells(i, 11).Value = "dow" 57 | i = i + 1 58 | Loop 59 | End Sub 60 | 61 | Sub formatSheet() 62 | 63 | Worksheets(2).Range("C3:MV3").ColumnWidth = 3 64 | Worksheets(2).Range("C3:MV3").RowHeight = 52 65 | 66 | Dim c As Integer, r As Integer, i As Integer 67 | 68 | Dim month As Range 69 | 70 | For i = 1 To 12 71 | r = 2 + i * 31 72 | c = 2 + r - 31 73 | Worksheets(2).Range(Cells(2, c), Cells(2, r)).Merge 74 | 75 | Next i 76 | 77 | 78 | 79 | End Sub 80 | 81 | 'Aller dans Mode de création puis propriété pour modifier le nom du bouton et l'associer à la fonction 82 | 'Ici au lieu de commandbutton1 j'ai "plus10" 83 | Private Sub plus10_Click() 84 | 85 | Dim i As Integer 86 | i = 1 87 | 88 | '<> means "not equal to" 89 | 'This do while stop when the cells (i,8(=G)) is empty 90 | Do While Cells(i, 7).Value <> "" 91 | Cells(i, 8).Value = Cells(i, 7).Value + 10 92 | i = i + 1 93 | Loop 94 | 95 | End Sub 96 | 97 | --------------------------------------------------------------------------------