├── .gitignore ├── C_sprintf.bas ├── Excel to Git.xlsm ├── ExportModules.bas ├── KeyValue.cls ├── README.md ├── Repositories.cls ├── Repositories.csv └── ThisWorkbook.cls /.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 | # ========================= 21 | # Operating System Files 22 | # ========================= 23 | 24 | # OSX 25 | # ========================= 26 | 27 | .DS_Store 28 | .AppleDouble 29 | .LSOverride 30 | 31 | # Thumbnails 32 | ._* 33 | 34 | # Files that might appear on external disk 35 | .Spotlight-V100 36 | .Trashes 37 | 38 | # Directories potentially created on remote AFP share 39 | .AppleDB 40 | .AppleDesktop 41 | Network Trash Folder 42 | Temporary Items 43 | .apdisk 44 | 45 | ################## 46 | *.bak 47 | ~$*xl* 48 | -------------------------------------------------------------------------------- /C_sprintf.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "C_sprintf" 2 | Option Explicit 3 | 4 | ' #VBIDEUtils#************************************************************ 5 | ' * Programmer Name : Thierry Waty 6 | ' * Web Site : http://www.vbdiamond.com 7 | ' * E-Mail : waty.thierry@vbdiamond.com 8 | ' * Date : 01/10/2001 9 | ' * Time : 13:38 10 | ' ********************************************************************** 11 | ' * Comments : Simulate in VB the "sprintf" function in C (updated) 12 | ' * 13 | ' * Simulate in VB the "sprintf" function in C 14 | ' * 15 | ' ********************************************************************** 16 | Const NONE = 0 17 | Const STRINGTYPE = 1 18 | Const INTEGERTYPE = 2 19 | Const LONGTYPE = 3 20 | Const FLOATTYPE = 4 21 | Const CHARPERCENT = 5 22 | Const HEXTYPE = 6 23 | 24 | Function SPrintf2(Mask As String, ParamArray Tokens()) As String 25 | 'SPrintf2("ab {1} de {0} fg", "XX", 123) 26 | 'Result: "ab 123 de XX fg" 27 | Dim I As Integer 28 | SPrintf2 = Mask 29 | For I = 0 To UBound(Tokens) 30 | SPrintf2 = Replace(SPrintf2, "{}", "{" & I & "}", , 1) 31 | Next 32 | For I = 0 To UBound(Tokens) 33 | SPrintf2 = Replace(SPrintf2, "{" & I & "}", Tokens(I)) 34 | Next 35 | End Function 36 | 37 | Public Function SPrintf(sFormats As String, ParamArray aArguments() As Variant) As String 38 | 39 | Dim nCurrentFlag As Long 40 | Dim nPos As Long 41 | Dim sWork As String 42 | Dim nCurVal As Long 43 | Dim nMaxArg As Integer 44 | Dim sCurFormat As String 45 | Dim nArgCount As Integer 46 | Dim nxIndex As Long 47 | Dim bFound As Boolean 48 | Dim nType As Integer 49 | Dim sCurParm As String 50 | Dim nLenFlags As Long 51 | Dim bUpper As Boolean 52 | 53 | ' If an array is passed, replace the ParamArray with it 54 | If UBound(aArguments) >= LBound(aArguments) Then 55 | If IsArray(aArguments(0)) Then 56 | aArguments = aArguments(0) 57 | End If 58 | End If 59 | 60 | ' *** Get the number of arguments 61 | nMaxArg = UBound(aArguments) + 1 62 | 63 | ' *** Length of the flags 64 | nLenFlags = Len(sFormats) 65 | 66 | ' *** Initialize some variables 67 | nCurrentFlag = 1 68 | nCurVal = 0 69 | nArgCount = 0 70 | 71 | ' *** Get the first flag 72 | nPos = InStr(nCurrentFlag, sFormats, "%") 73 | 74 | ' *** Verify if the number of flags is the same as the number of argument 75 | Do While (nPos > 0) 76 | If Mid$(sFormats, nPos + 1, 1) <> "%" Then ' *** Don't count %%, will be converted to % later 77 | nArgCount = nArgCount + 1 78 | nCurrentFlag = nPos + 1 79 | Else 80 | nCurrentFlag = nPos + 2 81 | End If 82 | 83 | ' *** Get next flag 84 | nPos = InStr(nCurrentFlag, sFormats, "%") 85 | Loop 86 | 87 | ' *** Compare the number of flags against the number of arguments 88 | If nArgCount <> nMaxArg Then Err.Raise 450, , "Mismatch of parameters for string " & sFormats & ". Expected " & nArgCount & " but received " & nMaxArg & "." 89 | 90 | ' *** Initialize some variables 91 | nCurrentFlag = 1 92 | nCurVal = 0 93 | nArgCount = 0 94 | sWork = "" 95 | 96 | ' *** Get the first flag 97 | nPos = InStr(nCurrentFlag, sFormats, "%") 98 | 99 | Do While (nPos > 0) 100 | ' *** First, get the variable identifier. 101 | ' *** Scan from nCurrentFlag (the %) to EOL looking for the 102 | ' *** first occurance of s, d, l, or f 103 | bFound = False 104 | nType = NONE 105 | nxIndex = nPos + 1 106 | Do While (bFound = False) And (nxIndex <= nLenFlags) 107 | If Not bFound Then 108 | sCurParm = Mid$(sFormats, nxIndex, 1) 109 | Select Case Mid$(sFormats, nxIndex, 1) 110 | Case "%" 111 | nType = CHARPERCENT 112 | bUpper = False 113 | bFound = True 114 | nPos = nPos + 1 115 | nCurVal = nxIndex + 2 116 | Case "s" 117 | nType = STRINGTYPE 118 | bUpper = False 119 | bFound = True 120 | nCurVal = nxIndex + 1 121 | Case "S" 122 | nType = STRINGTYPE 123 | bUpper = True 124 | bFound = True 125 | nCurVal = nxIndex + 1 126 | Case "d", "i", "u" 127 | nType = INTEGERTYPE 128 | bUpper = False 129 | bFound = True 130 | nCurVal = nxIndex + 1 131 | Case "l" 132 | If Mid$(sFormats, nxIndex + 1, 1) = "d" Then 133 | nType = LONGTYPE 134 | bUpper = False 135 | bFound = True 136 | nCurVal = nxIndex + 2 137 | Else 138 | Err.Raise 93, , "Unrecognized pattern " & Mid$(sFormats, nxIndex - 1, 3) & " in " & sFormats 139 | End If 140 | Case "f", "e", "g" 141 | nType = FLOATTYPE 142 | bUpper = False 143 | bFound = True 144 | nCurVal = nxIndex + 1 145 | Case "E", "G" 146 | nType = FLOATTYPE 147 | bUpper = False 148 | bFound = True 149 | nCurVal = nxIndex + 1 150 | Case "x" 151 | nType = HEXTYPE 152 | bUpper = False 153 | bFound = True 154 | nCurVal = nxIndex + 1 155 | Case "X" 156 | nType = HEXTYPE 157 | bUpper = True 158 | bFound = True 159 | nCurVal = nxIndex + 1 160 | End Select 161 | End If 162 | 163 | If Not bFound Then nxIndex = nxIndex + 1 164 | 165 | Loop 166 | 167 | ' *** Not found, raise an error 168 | If Not bFound Then Err.Raise 93, , "Invalid % format in <" & sFormats & ">" 169 | 170 | ' *** Get the complete flag 171 | sCurParm = Mid$(sFormats, nPos, nCurVal - nPos) 172 | 173 | ' *** Different case if Percent or other 174 | If nType = CHARPERCENT Then 175 | sWork = sWork & Mid$(sFormats, nCurrentFlag, nPos - nCurrentFlag) 176 | nCurVal = nCurVal - 1 177 | Else 178 | sCurFormat = BuildFormat(sCurParm, nType, bUpper, aArguments(nArgCount)) 179 | sWork = sWork & Mid$(sFormats, nCurrentFlag, nPos - nCurrentFlag) & sCurFormat 180 | nArgCount = nArgCount + 1 181 | End If 182 | nCurrentFlag = nCurVal 183 | 184 | ' *** Get next flag 185 | nPos = InStr(nCurrentFlag, sFormats, "%") 186 | Loop 187 | 188 | ' *** If there are no more flags, add the rest of the string and get out 189 | sWork = sWork & Mid$(sFormats, nCurrentFlag) 190 | 191 | SPrintf = TreatBackSlash(sWork) 192 | 193 | End Function 194 | 195 | Function BuildFormat(sFormat As String, nDataType As Integer, bUpperCase As Boolean, vCurrentValue As Variant) As String 196 | ' *** Build the format 197 | 198 | Dim sPrefix As String 199 | Dim sFlag As String 200 | Dim nWidth As Long 201 | Dim bAlignLeft As Boolean 202 | Dim bSign As Boolean 203 | Dim sPad As String * 1 204 | Dim bBlank As Boolean 205 | Dim bDecimal As Boolean 206 | Dim nI As Integer 207 | Dim sTmp As String 208 | Dim sWidth As String 209 | Dim nPrecision As Integer 210 | Dim nPlaces As Integer 211 | Dim NUnits As Integer 212 | Dim sCurrentValue As Variant 213 | 214 | If (Len(sFormat) < 2) Then 215 | BuildFormat = "" 216 | Exit Function 217 | End If 218 | 219 | ' *** Get the flag 220 | sFlag = "" 221 | bAlignLeft = False 222 | bSign = False 223 | sPad = "@" 224 | bBlank = False 225 | bDecimal = False 226 | Select Case Mid$(sFormat, 2, 1) 227 | Case "-": 228 | bAlignLeft = True 229 | sFormat = Mid$(sFormat, 3) 230 | 231 | Case "+": 232 | bSign = True 233 | sFormat = Mid$(sFormat, 3) 234 | 235 | Case "0": 236 | sPad = "0" 237 | sFormat = Mid$(sFormat, 3) 238 | 239 | Case " ": 240 | bBlank = True 241 | sFormat = Mid$(sFormat, 3) 242 | 243 | Case "#": 244 | bDecimal = True 245 | sFormat = Mid$(sFormat, 3) 246 | 247 | Case Else 248 | sFormat = Mid$(sFormat, 2) 249 | 250 | End Select 251 | 252 | ' *** Get the width 253 | If nDataType = LONGTYPE Then 254 | sPrefix = Mid$(sFormat, 1, Len(sFormat) - 2) 255 | Else 256 | sPrefix = Mid$(sFormat, 1, Len(sFormat) - 1) 257 | End If 258 | 259 | ' *** Get the width 260 | sWidth = "" 261 | nI = 1 262 | sTmp = Mid$(sPrefix, nI, 1) 263 | Do While IsNumeric(sTmp) 264 | sWidth = sWidth & sTmp 265 | 266 | nI = nI + 1 267 | sTmp = Mid$(sPrefix, nI, 1) 268 | Loop 269 | 270 | If (Trim$(sWidth) = "") Then sWidth = "0" 271 | nWidth = CLng(sWidth) 272 | 273 | ' *** Check the precision 274 | nPrecision = InStr(sPrefix, ".") 275 | If (nPrecision = 0) Then 276 | ' *** No precision, only width (eventually) 277 | If (bAlignLeft = False) Then 278 | sFormat = String(nWidth, sPad) 279 | Else 280 | If (Len(CStr(vCurrentValue)) > nWidth) Then nWidth = Len(CStr(vCurrentValue)) 281 | sFormat = String(Len(CStr(vCurrentValue)), sPad) & String(nWidth - Len(CStr(vCurrentValue)), " ") 282 | End If 283 | Else 284 | sTmp = "0" 285 | nI = nPrecision + 1 286 | Do While IsNumeric(Mid$(sPrefix, nI, 1)) 287 | sTmp = sTmp & Mid$(sPrefix, nI, 1) 288 | nI = nI + 1 289 | Loop 290 | 291 | nPlaces = CLng(sTmp) 292 | 293 | If nWidth < nPlaces Then 294 | If vCurrentValue Then 295 | NUnits = Int(Log(Abs(vCurrentValue)) / Log(10)) 296 | If NUnits < 0 Then NUnits = 0 297 | nWidth = nPlaces + 1 + NUnits + 1 + IIf(vCurrentValue < 0, 1, 0) 298 | Else 299 | nWidth = nPlaces + 2 300 | End If 301 | End If 302 | 303 | Select Case nDataType 304 | Case INTEGERTYPE, LONGTYPE, HEXTYPE: 305 | ' *** Take the right 'nWidth' characters because format with insert at least one space 306 | sFormat = Right$(Format$(" ", String$(nWidth - nPlaces, sPad)) & String$(nPlaces, "0"), nWidth) 307 | Case FLOATTYPE: 308 | sFormat = String$(nWidth - nPlaces - 2, "#") & "0." & String$(nPlaces, "0") 309 | End Select 310 | 311 | End If 312 | 313 | If nDataType = HEXTYPE Then 314 | ' *** Convert to Hex 315 | sCurrentValue = Hex$(vCurrentValue) 316 | 317 | ' *** Display the entire number even if the format is smaller 318 | If Len(sFormat) < Len(sCurrentValue) Then 319 | sFormat = vbNullString 320 | ' *** Else set the current value equal to the 0 padded string (if it's not 0 padded, 321 | ' *** the format works correctly already) 322 | ElseIf nPrecision <> 0 Or sPad = "0" Then 323 | sCurrentValue = Left$(sFormat, Len(sFormat) - Len(sCurrentValue)) & sCurrentValue 324 | sFormat = vbNullString 325 | End If 326 | 327 | Else 328 | sCurrentValue = vCurrentValue 329 | End If 330 | 331 | If nDataType <> STRINGTYPE Then 332 | If bUpperCase Then 333 | sCurrentValue = UCase(sCurrentValue) 334 | Else 335 | sCurrentValue = LCase(sCurrentValue) 336 | End If 337 | End If 338 | 339 | If sFormat = vbNullString Then 340 | BuildFormat = sCurrentValue 341 | Else 342 | BuildFormat = Format$(sCurrentValue, sFormat) 343 | If (nWidth - Len(BuildFormat)) < 0 Then 344 | BuildFormat = String(nWidth, "#") 345 | Else 346 | BuildFormat = String((nWidth - Len(BuildFormat)), " ") & BuildFormat 347 | End If 348 | End If 349 | 350 | End Function 351 | 352 | Public Function TreatBackSlash(sLine As String) As String 353 | ' *** Treat all the backslach 354 | 355 | Dim nPos As Long 356 | Dim sChar As String * 1 357 | 358 | ' *** Get the first backslash 359 | nPos = InStr(sLine, "\") 360 | 361 | Do While (nPos > 0) 362 | ' *** First, get the char after 363 | sChar = Mid$(sLine, nPos + 1, 1) 364 | Select Case sChar 365 | Case "n" 366 | sLine = Left$(sLine, nPos - 1) & Chr$(13) & Chr$(10) & Right$(sLine, Len(sLine) - nPos - 1) 367 | nPos = nPos + 1 368 | Case "r" 369 | sLine = Left$(sLine, nPos - 1) & Chr$(13) & Right$(sLine, Len(sLine) - nPos - 1) 370 | nPos = nPos + 1 371 | Case "t" 372 | sLine = Left$(sLine, nPos - 1) & Chr$(9) & Right$(sLine, Len(sLine) - nPos - 1) 373 | nPos = nPos + 1 374 | Case "\" 375 | sLine = Left$(sLine, nPos - 1) & "\" & Right$(sLine, Len(sLine) - nPos - 1) 376 | nPos = nPos + 1 377 | Case Else 378 | ' If there is not a recognizable flag, then take out the slash 379 | sLine = Left$(sLine, nPos - 1) & Right$(sLine, Len(sLine) - nPos) 380 | nPos = nPos + 1 381 | End Select 382 | 383 | nPos = InStr(nPos, sLine, "\") 384 | Loop 385 | 386 | TreatBackSlash = sLine 387 | 388 | End Function 389 | -------------------------------------------------------------------------------- /Excel to Git.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/stenci/ExcelToGit/399c18d222dbcbe990ed7b7b56adb435be6039f0/Excel to Git.xlsm -------------------------------------------------------------------------------- /ExportModules.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "ExportModules" 2 | Option Explicit 3 | 4 | Public Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long 5 | 6 | Global Const COL_EXPORT = 1 7 | Global Const COL_GIT_GUI = 2 8 | Global Const COL_GITK = 3 9 | Global Const COL_GIT_BASH = 4 10 | Global Const COL_NAME = 5 11 | Global Const COL_FILE_FOLDER = 6 12 | Global Const COL_GIT_FOLDER = 7 13 | 14 | Enum X 15 | vbext_ct_ActiveXDesigner = 11 16 | vbext_ct_ClassModule = 2 17 | vbext_ct_Document = 100 18 | vbext_ct_MSForm = 3 19 | vbext_ct_StdModule = 1 20 | End Enum 21 | 22 | Sub Export() 23 | Dim Name As String, GitFolder As String, FileFolder As String, FullName As String 24 | Name = ActiveCell.Cells(1, COL_NAME) 25 | GitFolder = ActiveCell.Cells(1, COL_GIT_FOLDER) 26 | FileFolder = ActiveCell.Cells(1, COL_FILE_FOLDER) 27 | FullName = FileFolder & "\" & Name 28 | 29 | GoToNameColumn 30 | 31 | If GitFolder = "" Then 32 | MsgBox "Missing GitFolder", vbCritical 33 | Exit Sub 34 | End If 35 | 36 | If Dir(GitFolder, vbDirectory) = "" Then 37 | MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical 38 | Exit Sub 39 | End If 40 | 41 | If MsgBox("Export """ & Name & """ to """ & GitFolder & """?", vbYesNo) <> vbYes Then Exit Sub 42 | 43 | Dim WB As Workbook 44 | On Error Resume Next 45 | Set WB = Workbooks(FullName) 46 | On Error GoTo 0 47 | If WB Is Nothing Then 48 | Application.EnableEvents = False 49 | Set WB = Workbooks.Open(FullName, UpdateLinks:=False, Editable:=True) 50 | Application.EnableEvents = True 51 | End If 52 | 53 | Dim VBProj 54 | Set VBProj = WB.VBProject 'see https://github.com/stenci/ExcelToGit 55 | 56 | Application.EnableEvents = False 57 | Application.DisplayAlerts = False 58 | 59 | Dim NewFiles As New Collection 60 | If WB.Path <> GitFolder Then ExecuteCommand "copy /y """ & FullName & """ """ & GitFolder & """" 61 | NewFiles.Add WB.Name 62 | 63 | Dim OldFiles As New Collection, FName As String 64 | FName = Dir(GitFolder & "\*") 65 | Do While FName <> "" 66 | If LCase(FName) <> ".gitignore" And _ 67 | LCase(FName) <> ".gitattributes" And _ 68 | LCase(FName) <> "readme.md" And _ 69 | LCase(FName) <> "readme.txt" _ 70 | Then OldFiles.Add FName 71 | FName = Dir() 72 | Loop 73 | 74 | Dim Comp, Components 75 | Set Components = VBProj.VBComponents 76 | For Each Comp In Components 77 | Select Case Comp.Type 78 | 79 | Case vbext_ct_ActiveXDesigner 80 | Stop 81 | 82 | Case vbext_ct_ClassModule 83 | Comp.Export GitFolder & "\" & Comp.Name & ".cls" 84 | NewFiles.Add Comp.Name & ".cls" 85 | 86 | Case vbext_ct_Document 87 | Comp.Export GitFolder & "\" & Comp.Name & ".cls" 88 | NewFiles.Add Comp.Name & ".cls" 89 | 90 | If Comp.Name <> "ThisWorkbook" Then 91 | Dim Sh As Worksheet, ShName As String, IsVisible As XlSheetVisibility, ActiveSh As Worksheet 92 | Set Sh = SheetWithCodeName(WB, Comp.Name) 93 | IsVisible = Sh.Visible 94 | ShName = Sh.Name 95 | If IsAddin(WB.Name) Then WB.IsAddin = False 96 | Set ActiveSh = WB.ActiveSheet 97 | If IsVisible <> xlSheetVisible Then Sh.Visible = xlSheetVisible 98 | WB.Activate 99 | Sh.Select 100 | 101 | ActiveWindow.DisplayFormulas = True 102 | WB.SaveAs FileName:=GitFolder & "\" & CsvShName(Comp.Name, ShName) & ".csv", FileFormat:=xlCSV, CreateBackup:=False 103 | ActiveWindow.DisplayFormulas = False 104 | NewFiles.Add CsvShName(Comp.Name, ShName) & ".csv" 105 | 106 | Sh.Name = ShName 107 | ActiveSh.Activate 108 | If IsVisible <> xlSheetVisible Then Sh.Visible = IsVisible 109 | If IsAddin(WB.Name) Then WB.IsAddin = True 110 | ThisWorkbook.Activate 111 | End If 112 | 113 | Case vbext_ct_MSForm 114 | Comp.Export GitFolder & "\" & Comp.Name & ".frm" 115 | NewFiles.Add Comp.Name & ".frm" 116 | Kill GitFolder & "\" & Comp.Name & ".frx" 117 | 118 | Case vbext_ct_StdModule 119 | Comp.Export GitFolder & "\" & Comp.Name & ".bas" 120 | NewFiles.Add Comp.Name & ".bas" 121 | 122 | Case Else 123 | Stop 124 | 125 | End Select 126 | Next Comp 127 | 128 | If WB Is ThisWorkbook Then 129 | WB.SaveAs FileName:=FullName, FileFormat:=Ext2Format(FullName), CreateBackup:=False 130 | Else 131 | WB.Close 132 | End If 133 | 134 | Application.DisplayAlerts = True 135 | Application.EnableEvents = True 136 | 137 | Dim Iold As Integer, Inew As Integer 138 | For Inew = 1 To NewFiles.Count 139 | For Iold = 1 To OldFiles.Count 140 | If LCase(OldFiles(Iold)) = LCase(NewFiles(Inew)) Then 141 | OldFiles.Remove Iold 142 | Exit For 143 | End If 144 | Next Iold 145 | Next Inew 146 | 147 | Dim Txt As String 148 | If OldFiles.Count Then 149 | Txt = "Delete the following files?" 150 | For Iold = 1 To OldFiles.Count 151 | Txt = Txt & vbLf & OldFiles(Iold) 152 | Next Iold 153 | 154 | If MsgBox(Txt, vbYesNo) = vbYes Then 155 | For Iold = 1 To OldFiles.Count 156 | Kill GitFolder & "\" & OldFiles(Iold) 157 | Next Iold 158 | End If 159 | End If 160 | End Sub 161 | 162 | Function SheetWithCodeName(WB As Workbook, CodeName As String) As Worksheet 163 | For Each SheetWithCodeName In WB.Worksheets 164 | If UCase(SheetWithCodeName.CodeName) = UCase(CodeName) Then Exit Function 165 | Next SheetWithCodeName 166 | Set SheetWithCodeName = Nothing 167 | End Function 168 | 169 | Function Ext2Format(FileName As String) As XlFileFormat 170 | If Right(FileName, 4) = ".xla" Then 171 | Ext2Format = xlAddIn 172 | ElseIf Right(FileName, 4) = ".xls" Then 173 | Ext2Format = xlExcel8 174 | ElseIf Right(FileName, 5) = ".xlsx" Then 175 | Ext2Format = xlOpenXMLWorkbook 176 | ElseIf Right(FileName, 5) = ".xlsm" Then 177 | Ext2Format = xlOpenXMLWorkbookMacroEnabled 178 | ElseIf Right(FileName, 5) = ".xltm" Then 179 | Ext2Format = xlOpenXMLTemplateMacroEnabled 180 | End If 181 | End Function 182 | 183 | Function CsvShName(CompName As String, ShName As String) As String 184 | If CompName = ShName Then 185 | CsvShName = CompName 186 | Else 187 | CsvShName = CompName & " (" & ShName & ")" 188 | End If 189 | End Function 190 | 191 | Sub Refresh() 192 | Dim WB As Workbook, AI As AddIn 193 | 194 | Application.EnableEvents = False 195 | 196 | For Each WB In Workbooks 197 | AddIfMissing WB 198 | Next WB 199 | 200 | For Each AI In AddIns 201 | If UCase(Right(AI.Name, 4)) <> ".XLL" And UCase(Right(AI.Name, 5)) <> ".XLAM" Then 202 | AddIfMissing Workbooks(AI.Name) 203 | End If 204 | Next AI 205 | 206 | Dim C As Integer 207 | ActiveSheet.UsedRange.EntireColumn.AutoFit 208 | For C = 1 To ActiveSheet.UsedRange.Columns.Count 209 | If ActiveSheet.Columns(C).EntireColumn.ColumnWidth > 40 Then ActiveSheet.Columns(C).EntireColumn.ColumnWidth = 40 210 | Next C 211 | 212 | Application.EnableEvents = True 213 | 214 | GoToNameColumn 215 | End Sub 216 | 217 | Sub GoToNameColumn() 218 | Application.EnableEvents = False 219 | Cells(ActiveCell.Row, 5).Select 220 | Application.EnableEvents = True 221 | End Sub 222 | 223 | Sub AddIfMissing(WB As Workbook) 224 | Dim R As Integer, DocFolder As String, Name As String 225 | DocFolder = WB.Path 226 | Name = WB.Name 227 | 228 | For R = 4 To ActiveSheet.UsedRange.Rows.Count 229 | If Cells(R, COL_NAME) = Name And Cells(R, COL_FILE_FOLDER) = DocFolder Then Exit Sub 230 | Next R 231 | 232 | If IsEmpty(Cells(R - 1, 5)) Then R = R - 1 233 | 234 | Cells(R, COL_EXPORT) = "Export" 235 | Cells(R, COL_GIT_GUI) = "Git gui" 236 | Cells(R, COL_GITK) = "gitk" 237 | Cells(R, COL_GIT_BASH) = "bash" 238 | Cells(R, COL_NAME) = Name 239 | Cells(R, COL_FILE_FOLDER) = DocFolder 240 | End Sub 241 | 242 | Function IsAddin(Name As String) As Boolean 243 | IsAddin = UCase(Right(Name, 4)) = ".XLA" 244 | End Function 245 | 246 | Sub OpenFolder(FolderName As Range) 247 | If FolderName = "" Then Exit Sub 248 | If Dir(FolderName, vbDirectory) = "" Then 249 | MsgBox "Folder """ & FolderName & """ not found", vbCritical 250 | Exit Sub 251 | End If 252 | 253 | Dim FileName As String 254 | FileName = FolderName.Value & "\" & FolderName.Worksheet.Cells(FolderName.Row, COL_NAME) 255 | 256 | Dim SystemRoot As String, Shell As New Shell 257 | SystemRoot = Environ("SystemRoot") 258 | If Dir(FileName) <> "" Then 259 | Shell.ShellExecute SystemRoot & "\Explorer.exe", "/select, """ & FileName & """", "", "open", 1 260 | Else 261 | Shell.ShellExecute SystemRoot & "\Explorer.exe", """" & FolderName.Value & """", "", "open", 1 262 | End If 263 | 264 | GoToNameColumn 265 | End Sub 266 | 267 | Sub ExecuteCommand(Command As String) 268 | Static LastId As Integer 269 | Dim CmdFile As String 270 | LastId = LastId + 1 271 | CmdFile = Environ("TEMP") & "\ExcelToGit" & LastId & ".cmd" 272 | Open CmdFile For Output As #1 273 | Print #1, Replace(Command, "%", "%%") 274 | Close #1 275 | Shell CmdFile 276 | End Sub 277 | 278 | Function GitExeFolder() As String 279 | If Dir("C:\Program Files (x86)\Git", vbDirectory) <> "" Then 280 | GitExeFolder = "C:\Program Files (x86)\Git" 281 | ElseIf Dir("C:\Program Files\Git", vbDirectory) <> "" Then 282 | GitExeFolder = "C:\Program Files\Git" 283 | Else 284 | Stop 285 | End If 286 | End Function 287 | 288 | Sub GitGui() 289 | Dim GitFolder As String 290 | GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER) 291 | 292 | If GitFolder = "" Then 293 | MsgBox "Missing GitFolder", vbCritical 294 | Exit Sub 295 | End If 296 | 297 | If Dir(GitFolder, vbDirectory) = "" Then 298 | MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical 299 | Exit Sub 300 | End If 301 | 302 | ChDir2 GitFolder 303 | Shell """" & GitExeFolder & "\cmd\Git-gui.exe""" 304 | 305 | GoToNameColumn 306 | End Sub 307 | 308 | Sub ChDir2(Path As String) 309 | If Left(Path, 2) = "\\" Then 310 | SetCurrentDirectoryA Path 311 | Else 312 | If Mid(Path, 2, 1) = ":" Then ChDrive Left(Path, 2) 313 | ChDir Path 314 | End If 315 | End Sub 316 | 317 | Sub Gitk() 318 | Dim GitFolder As String 319 | GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER) 320 | 321 | If GitFolder = "" Then 322 | MsgBox "Missing GitFolder", vbCritical 323 | Exit Sub 324 | End If 325 | 326 | If Dir(GitFolder, vbDirectory) = "" Then 327 | MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical 328 | Exit Sub 329 | End If 330 | 331 | ChDir2 GitFolder 332 | Shell """" & GitExeFolder & "\cmd\Gitk.exe"" --all" 333 | 334 | GoToNameColumn 335 | End Sub 336 | 337 | Sub GitBash() 338 | Dim GitFolder As String 339 | GitFolder = Cells(ActiveCell.Row, COL_GIT_FOLDER) 340 | 341 | If GitFolder = "" Then 342 | MsgBox "Missing GitFolder", vbCritical 343 | Exit Sub 344 | End If 345 | 346 | If Dir(GitFolder, vbDirectory) = "" Then 347 | MsgBox "The GitFolder """ & GitFolder & """ is missing", vbCritical 348 | Exit Sub 349 | End If 350 | 351 | ChDir2 GitFolder 352 | Shell """" & GitExeFolder & "\Git-bash.exe""" 353 | 354 | GoToNameColumn 355 | End Sub 356 | 357 | Function FolderName(FullPath As String) As String 358 | FolderName = Mid(FullPath, InStrRev(FullPath, "\") + 1) 359 | End Function 360 | 361 | Function GetFilesIn(Folder As String) As Collection 362 | Dim F As String 363 | Set GetFilesIn = New Collection 364 | F = Dir(Folder & "\*") 365 | Do While F <> "" 366 | GetFilesIn.Add F 367 | F = Dir 368 | Loop 369 | End Function 370 | 371 | Function GetFoldersIn(Folder As String) As Collection 372 | Dim F As String 373 | Set GetFoldersIn = New Collection 374 | F = Dir(Folder & "\*", vbDirectory) 375 | Do While F <> "" 376 | If GetAttr(Folder & "\" & F) And vbDirectory Then GetFoldersIn.Add F 377 | F = Dir 378 | Loop 379 | End Function 380 | 381 | Sub TestQuickSortArrayKV() 382 | Dim I As Integer, Arr(3 To 12) As KeyValue, N As Integer 383 | For I = LBound(Arr) To UBound(Arr) 384 | N = Rnd * UBound(Arr) 385 | Set Arr(I) = NewKeyValue(N, N) 386 | Next I 387 | 388 | QuickSortArrayKV Arr 389 | 390 | PrintArray Arr 391 | End Sub 392 | 393 | Sub QuickSortArrayKVGetValues(Arr() As KeyValue, Result) 394 | QuickSortArrayKV Arr 395 | 396 | Dim I As Integer 397 | ReDim Result(UBound(Arr)) 398 | For I = LBound(Arr) To UBound(Arr) 399 | Set Result(I) = Arr(I).Value 400 | Next I 401 | End Sub 402 | 403 | Sub QuickSortArrayKV(Arr() As KeyValue, Optional IStart As Integer = -999, Optional IEnd As Integer) 404 | If IStart = -999 Then 405 | IStart = LBound(Arr) 406 | IEnd = UBound(Arr) 407 | End If 408 | 409 | Dim I As Integer, K As Integer, PivotKey 410 | I = IStart 411 | K = IEnd 412 | 413 | If IEnd - IStart >= 1 Then 414 | PivotKey = Arr(IStart).Key 415 | 416 | Do While K > I 417 | Do While Arr(I).Key <= PivotKey And I <= IEnd And K > I 418 | I = I + 1 419 | Loop 420 | 421 | Do While Arr(K).Key > PivotKey And K >= IStart And K >= I 422 | K = K - 1 423 | Loop 424 | 425 | If K > I Then SwapArrayKV Arr, I, K 426 | Loop 427 | 428 | SwapArrayKV Arr, IStart, K 429 | 430 | QuickSortArrayKV Arr, IStart, K - 1 431 | QuickSortArrayKV Arr, K + 1, IEnd 432 | End If 433 | End Sub 434 | 435 | Sub QuickSortArray(Arr(), Optional IStart As Integer = -999, Optional IEnd As Integer) 436 | If IStart = -999 Then 437 | IStart = LBound(Arr) 438 | IEnd = UBound(Arr) 439 | End If 440 | 441 | Dim I As Integer, K As Integer, PivotKey 442 | I = IStart 443 | K = IEnd 444 | 445 | If IEnd - IStart >= 1 Then 446 | PivotKey = Arr(IStart) 447 | 448 | Do While K > I 449 | Do While Arr(I) <= PivotKey And I <= IEnd And K > I 450 | I = I + 1 451 | Loop 452 | 453 | Do While Arr(K) > PivotKey And K >= IStart And K >= I 454 | K = K - 1 455 | Loop 456 | 457 | If K > I Then SwapArray Arr, I, K 458 | Loop 459 | 460 | SwapArray Arr, IStart, K 461 | 462 | QuickSortArray Arr, IStart, K - 1 463 | QuickSortArray Arr, K + 1, IEnd 464 | End If 465 | End Sub 466 | 467 | Function QuickSort(ByVal Coll As Collection) As Collection 468 | If Coll.Count <= 1 Then 469 | Set QuickSort = Coll 470 | Exit Function 471 | End If 472 | 473 | Dim Smaller As New Collection, Bigger As New Collection 474 | Dim Pivot As Variant, N As Long, V As Variant 475 | 476 | N = Coll.Count / 2 477 | Pivot = Coll(N) 478 | Coll.Remove N 479 | 480 | Do While Coll.Count 481 | If Coll(1) < Pivot Then Smaller.Add Coll(1) Else Bigger.Add Coll(1) 482 | Coll.Remove 1 483 | Loop 484 | 485 | Set QuickSort = New Collection 486 | 487 | For Each V In QuickSort(Smaller) 488 | QuickSort.Add V 489 | Next V 490 | 491 | QuickSort.Add Pivot 492 | 493 | For Each V In QuickSort(Bigger) 494 | QuickSort.Add V 495 | Next V 496 | End Function 497 | 498 | Function QuickSortKVGetValues(ByVal Coll As Collection) As Collection 499 | Dim C1 As Collection, C2 As New Collection, V As Variant 500 | Set C1 = QuickSortKV(Coll) 501 | For Each V In C1 502 | C2.Add V.Value 503 | Next V 504 | Set QuickSortKVGetValues = C2 505 | End Function 506 | 507 | Function QuickSortKV(ByVal Coll As Collection) As Collection 508 | If Coll.Count <= 1 Then 509 | Set QuickSortKV = Coll 510 | Exit Function 511 | End If 512 | 513 | Dim Smaller As New Collection, Bigger As New Collection 514 | Dim Pivot As KeyValue, N As Long, V As KeyValue 515 | 516 | N = Coll.Count / 2 517 | Set Pivot = Coll(N) 518 | Coll.Remove N 519 | 520 | Do While Coll.Count 521 | If Coll(1).Key < Pivot.Key Then Smaller.Add Coll(1) Else Bigger.Add Coll(1) 522 | Coll.Remove 1 523 | Loop 524 | 525 | Set QuickSortKV = New Collection 526 | 527 | For Each V In QuickSortKV(Smaller) 528 | QuickSortKV.Add V 529 | Next V 530 | 531 | QuickSortKV.Add Pivot 532 | 533 | For Each V In QuickSortKV(Bigger) 534 | QuickSortKV.Add V 535 | Next V 536 | End Function 537 | 538 | Function NewKeyValue(Key As Variant, Value As Variant) As KeyValue 539 | Set NewKeyValue = New KeyValue 540 | NewKeyValue.Init Key, Value 541 | End Function 542 | 543 | Sub SwapArrayKV(Arr() As KeyValue, I1 As Integer, I2 As Integer) 544 | Dim O As Object 545 | Set O = Arr(I1) 546 | Set Arr(I1) = Arr(I2) 547 | Set Arr(I2) = O 548 | End Sub 549 | 550 | Sub SwapArray(Arr(), I1 As Integer, I2 As Integer) 551 | Dim X 552 | X = Arr(I1) 553 | Arr(I1) = Arr(I2) 554 | Arr(I2) = X 555 | End Sub 556 | 557 | Sub PrintArray(Arr() As KeyValue) 558 | Dim I As Integer 559 | For I = LBound(Arr) To UBound(Arr) 560 | Debug.Print Arr(I).Value; 561 | Next I 562 | Debug.Print 563 | End Sub 564 | -------------------------------------------------------------------------------- /KeyValue.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "KeyValue" 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 | Public Key As Variant 13 | Public Value As Variant 14 | 15 | Sub Init(Key As Variant, Value As Variant) 16 | Me.Key = Key 17 | If IsObject(Value) Then Set Me.Value = Value Else Me.Value = Value 18 | End Sub 19 | 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Deprecated: ExcelToGit 2 | This project has been superseded by [VbaGitSync](https://github.com/stenci/VbaGitSync). It is more robust, modular, and actively maintained. 3 | 4 | This repository is no longer maintained. 5 | 6 | # ExcelToGit 7 | Export Excel workbook macros and data to Git friendly text format. 8 | 9 | The macro exports all the VBA code to .bas, .cls and .frm files and all the worksheets to .csv format. 10 | 11 | Addins (.xla files) are temporarily set to `.IsAddin = False` in order to select the sheets and export them as .csv. 12 | 13 | The macro first exports each sheet as .csv, then saves the file back with its original format. 14 | The side effect is that the next time the file is opened, Excel may not trust it and ask to enable the macros. 15 | (I haven't seen this happening in a long time, I don't know if it's the result of my configuration of some Microsoft 16 | updates.) 17 | 18 | In order for the VBA macro to export the VBA code an Excel setting must be changed: 19 | * In Excel 2003 and earlier: go the Tools - Macros - Security, then click on the Trusted Publishers tab and 20 | check Trust access to the Visual Basic Project. 21 | * In Excel 2007 and later: click the Developer item on the main Ribbon, then click the Macro Security item in the 22 | Code panel, then in the Macro Settings page check the Trust access to the VBA project object model. 23 | 24 | ### Examples 25 | The first 5 rows are examples use cases, the following row is the real one that I use for this addin. 26 | Here is the description of the 5 examples: 27 | 28 | #### Addin.xla 29 | The addin is located on the AppData folder and is installed, so it is always loaded. I don't like to keep the git files 30 | in the AppData folder, and I don't like to uninstall/install the addin every time I need to export to the text files. 31 | So I configure it with two different folders, and clicking on **Export** will create all the text files 32 | in **Git folder** and copy the original file from **File to export folder** to **Git folder**. 33 | 34 | #### Macro.xlsm 35 | **Folder** and **Git folder** are the same because this is not an addin, so it is not installed, so it is possible to 36 | keep it on the same folder with the git files. 37 | 38 | #### App 39 | This is not an Excel file. It is just like any other app with its own git rpository which includes two Xl folders, each 40 | with its own Excel file and its macros. The **Export** button here is missing, because there are no Excel macros or 41 | sheets to export. 42 | 43 | #### App1.xlsm and App2.xlsm 44 | These are two Excel macros, each living in its folder with its exported text files created by clicking on the 45 | **Export** button. The **Git gui**, **gitk** and **bash** buttons are missing because the git repository that includes 46 | both the macros is **App**. 47 | -------------------------------------------------------------------------------- /Repositories.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "Repositories" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Option Explicit 11 | 12 | -------------------------------------------------------------------------------- /Repositories.csv: -------------------------------------------------------------------------------- 1 | Actions,,,,Name,File to export folder,Git folder 2 | Export,Git gui,gitk,bash,Addin.xla,C:\Users\Me\AppData\Roaming\Microsoft\AddIns\Addin.xla,N:\Git\Addin 3 | Export,Git gui,gitk,bash,Macro.xlsm,C:\MyFolder,N:\Git\Macro 4 | ,Git gui,gitk,bash,App,C:\MyFolder,N:\Git\App 5 | Export,,,,App1.xlsm,C:\MyFolder,N:\Git\App\Xl\App1 6 | Export,,,,App2.xlsm,C:\MyFolder,N:\Git\App\Xl\App2 7 | ,,,,,, 8 | Export,Git gui,gitk,bash,Excel to Git.xlsm,N:\Tools\Git\Excel To Git,N:\Tools\Git\Excel To Git 9 | -------------------------------------------------------------------------------- /ThisWorkbook.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "ThisWorkbook" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = True 9 | Attribute VB_Exposed = True 10 | Option Explicit 11 | 12 | Private Sub Workbook_BeforeClose(Cancel As Boolean) 13 | Dim Folder As String, File As String 14 | Folder = Environ("TEMP") 15 | File = Dir(Folder & "\ExcelToGit*") 16 | Do While File <> "" 17 | Kill Folder & "\" & File 18 | File = Dir 19 | Loop 20 | End Sub 21 | 22 | Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 23 | Dim Txt As String, C As Integer 24 | If Target.Rows.Count > 1 Then Exit Sub 25 | If Target.Row > 1 And Target.Columns.Count > 1 Then Exit Sub 26 | C = Target.Column 27 | If C = COL_EXPORT Or C = COL_GIT_GUI Or C = COL_GITK Or C = COL_GIT_BASH Then 28 | Txt = Target.Cells(1, 1).Value2 29 | Select Case Txt 30 | Case "Refresh list of open documents": Refresh 31 | Case "Export": Export 32 | Case "Git gui": GitGui 33 | Case "gitk": Gitk 34 | Case "bash": GitBash 35 | End Select 36 | ElseIf C = COL_GIT_FOLDER Or C = COL_FILE_FOLDER Then 37 | OpenFolder Cells(Target.Row, C) 38 | End If 39 | End Sub 40 | --------------------------------------------------------------------------------