Commits

Christoph Jüngling  committed 5895e0d

Export code and class for Excel added

  • Participants
  • Parent commits 919f638

Comments (0)

Files changed (2)

File ExportExcelCode.bas

+Attribute VB_Name = "ExportExcelCode"
+Option Explicit
+
+Public Sub DoExport()
+
+' TODO: Umwandeln in eine Klasse, um Fortschritts-Events zu testen
+
+Dim ex As clsExportExcelCode
+
+Set ex = New clsExportExcelCode
+ex.Path = AddBackslash(ActiveWorkbook.Path) & ActiveWorkbook.Name & ".src\"
+ex.export
+Set ex = Nothing
+
+End Sub
+
+''
+' Add backslash at end of a string, if not present
+'
+' @param    Path   Original path
+' @return   Path with (additional) backslash at the end
+'
+Private Function AddBackslash(ByRef Path As String) As String
+
+Path = Trim(Path)
+If Right(Path, 1) <> "\" Then Path = Path & "\"
+AddBackslash = Path
+
+End Function

File clsExportExcelCode.bas

+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "clsExportExcelCode"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+''
+' Export Visio code
+'
+' @author   Christoph Juengling <chris@juengling-edv.de>
+' @link   https://bitbucket.org/juengling/vb-and-vba-code-library
+'
+Option Explicit
+
+Public Event ExportStarted(ObjectCount As Long)
+Public Event Exporting(ObjectName As String, DestinationFile As String)
+Public Event ExportFinished()
+
+Private m_sPath As String
+
+' Export complete source code of active workbook to a subfolder
+'
+' @remarks  Early binding needs reference "Microsoft Visual Basic for Applications Extensibility 5.3"
+'
+Public Sub export()
+
+Const FUNCTION_NAME = "Export"
+
+'Dim VBComp As VBIDE.VBComponent ' early binding
+Dim VBComp As Object            ' late binding
+Dim sExportFile As String
+
+'------------------------------
+
+On Error GoTo Catch
+
+RaiseEvent ExportStarted(ActiveWorkbook.VBProject.VBComponents.Count)
+For Each VBComp In ActiveWorkbook.VBProject.VBComponents
+    sExportFile = Me.Path & VBComp.Name & ".bas"
+    Debug.Print sExportFile
+    RaiseEvent Exporting(VBComp.Name, sExportFile)
+    VBComp.export sExportFile
+Next VBComp
+
+RaiseEvent ExportFinished
+
+'------------------------
+Final:
+Exit Sub
+
+'------------------------
+Catch:
+Select Case Err.Number
+    Case Else
+        Err.Raise Err.Number, TypeName(Me) & "." & FUNCTION_NAME & "/" & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
+End Select
+Resume Final
+Resume ' for test purposes only
+
+End Sub
+
+''
+' Initialize class instance
+'
+Private Sub Class_Initialize()
+
+m_sPath = ""
+
+End Sub
+
+''
+' Get path
+'
+' @return   current path for export
+'
+Public Property Get Path() As String
+
+Path = m_sPath
+
+End Property
+
+''
+' Set new path
+'
+' @param    newPath   New path
+'
+Public Property Let Path(ByVal newPath As String)
+
+On Error Resume Next
+MkDir newPath
+
+On Error GoTo 0
+m_sPath = newPath
+
+End Property