Merge branch 'header-rows'

CHANGELOG.md

@@ -6,13 +6,18 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
 and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html).
 
 
-### [Unreleased]
+### [1.2.0.dev1] - 2020-02-03
+
+Development release issued, to facilitate user testing before considering
+the below new features as "final".
 
 #### Added
 
 - Hidden rows and columns now are **NOT** exported by default; checkboxes
   to enable export of hidden cells (per row and/or per-column) are
   now provided
+- An option is now provided to export the cells from one or more rows on
+  the active sheet above/below the exported data block as "header row(s)"
 
 ### [1.1.0] - 2019-01-08
 

LICENSE.txt

@@ -1,6 +1,6 @@
 The MIT License (MIT)
 
-Copyright (c) 2016-2019 Brian Skinn
+Copyright (c) 2016-2020 Brian Skinn
 
 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal

README.md

@@ -6,7 +6,7 @@ See the project [wiki](https://github.com/bskinn/excel-csvexporter/wiki) for doc
 
 The binary `.xlam` file for each release can be found on the GitHub page for that release.
 
-Copyright (c) Brian Skinn 2016-2019
+Copyright (c) Brian Skinn 2016-2020
 
 License: The MIT License  
 See [`LICENSE.txt`](https://github.com/bskinn/excel-csvexporter/blob/master/LICENSE.txt) for full license terms.

src/Exporter.bas

@@ -8,7 +8,7 @@ Attribute VB_Name = "Exporter"
 ' #                [email protected]
 ' #
 ' # Created:     24 Jan 2016
-' # Copyright:   (c) Brian Skinn 2016-2019
+' # Copyright:   (c) Brian Skinn 2016-2020
 ' # License:     The MIT License; see "LICENSE.txt" for full license terms.
 ' #
 ' #       http://www.github.com/bskinn/excel-csvexporter

src/UFExporter.frm

@@ -1,7 +1,7 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UFExporter 
    Caption         =   "Export Data Range"
-   ClientHeight    =   4770
+   ClientHeight    =   5955
    ClientLeft      =   45
    ClientTop       =   375
    ClientWidth     =   4560
@@ -15,6 +15,8 @@ Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 
+
+
 ' # ------------------------------------------------------------------------------
 ' # Name:        UFExporter.frm
 ' # Purpose:     Core UserForm for the CSV Exporter Excel VBA Add-In
@@ -23,7 +25,7 @@ Attribute VB_Exposed = False
 ' #                [email protected]
 ' #
 ' # Created:     24 Jan 2016
-' # Copyright:   (c) Brian Skinn 2016-2019
+' # Copyright:   (c) Brian Skinn 2016-2020
 ' # License:     The MIT License; see "LICENSE.txt" for full license terms.
 ' #
 ' #       http://www.github.com/bskinn/excel-csvexporter
@@ -40,13 +42,15 @@ Attribute appn.VB_VarHelpID = -1
 ' =====  CONSTANTS  =====
 Const NoFolderStr As String = "<none>"
 Const InvalidSelStr As String = "<invalid selection>"
+Const NoHeaderRngStr As String = "<no header>"
 
 
 ' =====  GLOBALS  =====
 Dim WorkFolder As Folder
 Dim fs As FileSystemObject
 Dim ExportRange As Range
 Dim HiddenByChart As Boolean
+Dim wsf As worksheetfunction
 
 
 ' =====  EVENT-ENABLED APPLICATION EVENTS  =====
@@ -174,7 +178,14 @@ Private Sub BtnExport_Click()
     End If
 
     ' Ready to go. Pass info to writing function
-    writeCSV ExportRange, tStrm, TxBxFormat.Value, TxBxSep.Value
+    ' Header first (always exporting, even if hidden; but only if enabled)...
+    If ChBxHeaderRows.Value Then
+        writeCSV dataRg:=getHeaderRange, tStrm:=tStrm, nFormat:=TxBxFormat.Value, _
+                Separator:=TxBxSep.Value, overrideHidden:=True
+    End If
+    ' ... then body (obeying 'hidden cell export' settings)
+    writeCSV dataRg:=ExportRange, tStrm:=tStrm, nFormat:=TxBxFormat.Value, _
+            Separator:=TxBxSep.Value, overrideHidden:=False
 
     ' Close the stream
     tStrm.Close
@@ -222,6 +233,42 @@ Private Sub BtnSelectFolder_Click()
 
 End Sub
 
+Private Sub ChBxHeaderRows_Change()
+    ' Set the header rows box colors appropriately
+    setHeaderTBxColors
+
+    ' Update the range report box
+    setExportRangeText
+
+    ' Update Export button
+    setExportEnabled
+
+End Sub
+
+Private Sub TBxHeaderStart_Change()
+    ' Set header rows box colors
+    setHeaderTBxColors
+
+    ' Update the range report box
+    setExportRangeText
+
+    ' Update export button
+    setExportEnabled
+
+End Sub
+
+Private Sub TBxHeaderStop_Change()
+    ' Set header rows box colors
+    setHeaderTBxColors
+
+    ' Update the range report box
+    setExportRangeText
+
+    ' Update export button
+    setExportEnabled
+
+End Sub
+
 Private Sub TxBxFilename_Change()
 
     ' If filename is nonzero-length and valid, set color black.
@@ -280,6 +327,9 @@ Private Sub UserForm_Initialize()
     ' General is default number format
     TxBxFormat.Value = "@"
 
+    ' Bind the worksheet function object
+    Set wsf = Application.worksheetfunction
+
 End Sub
 
 
@@ -294,7 +344,8 @@ Private Sub setExportEnabled()
         validFilename(TxBxFilename.Value) And _
         Len(TxBxFormat.Value) > 0 And _
         (Not WorkFolder Is Nothing) And _
-        (Not ExportRange Is Nothing) _
+        (Not ExportRange Is Nothing) And _
+        (Not (ChBxHeaderRows.Value And Not checkHeaderRowValues)) _
     ) Then
         BtnExport.Enabled = True
     Else
@@ -338,6 +389,9 @@ Private Sub setExportRangeText()
     workStr = "  Worksheet: " _
         & Selection.Parent.Name _
         & Chr(10) _
+        & "  Header: " _
+        & getHeaderRangeAddress _
+        & Chr(10) _
         & "  Range: " _
         & getExportRangeAddress
 
@@ -361,11 +415,124 @@ Private Function getExportRangeAddress() As String
 
 End Function
 
+Private Function getHeaderRangeAddress() As String
+    ' Helper for concise generation of the header range address
+    ' without dollar signs.
+    '
+    ' Or, if header export is deselected, report accordingly
+
+    If ChBxHeaderRows.Value Then
+        If checkHeaderRowValues Then
+            getHeaderRangeAddress = getHeaderRange.Address( _
+                        RowAbsolute:=False, ColumnAbsolute:=False _
+            )
+        Else
+            getHeaderRangeAddress = InvalidSelStr
+        End If
+    Else
+        getHeaderRangeAddress = NoHeaderRngStr
+    End If
+
+End Function
+
+Private Function getHeaderRange() As Range
+    ' Helper to actually generate a reference to the header range,
+    ' given the currently set export range.
+    '
+    ' If any of the form is in a state where the header range
+    ' can't be defined, returns Nothing.
+
+    Dim headerFullRows As Range
+    Dim startRow As Long, stopRow As Long
+    Dim errNum As Long
+
+    Set getHeaderRange = Nothing
+
+    If Not ChBxHeaderRows.Value Then Exit Function
+    If Not checkHeaderRowValues Then Exit Function
+    If ExportRange Is Nothing Then Exit Function
+
+    ' Handle the case where the start value is blank (implicit start at '1')
+    On Error Resume Next
+        startRow = CLng(TBxHeaderStart.Value)
+    errNum = Err.Number: Err.Clear: On Error GoTo 0
+
+    Select Case errNum
+    Case 13
+        startRow = 1
+    End Select
+
+    ' Stop row shouldn't(?) need special handling, given that it's already
+    ' proofed by the above checks
+    stopRow = CLng(TBxHeaderStop.Value)
+
+    Set headerFullRows = ExportRange.Worksheet.Rows(startRow)
+    Set headerFullRows = headerFullRows.Resize(stopRow - startRow + 1)
+
+    Set getHeaderRange = Intersect(ExportRange.EntireColumn, headerFullRows)
+
+End Function
+
+Private Function checkHeaderRowValues() As Boolean
+    ' Proofreads the values in the row start/stop for the header inclusion
+    '
+    ' True means values are ok (numbers, and start <= stop)
+    ' False means something (unspecified) is wrong;
+    '  could be non-numeric, or start > stop
+
+    Dim errNum As Long, startRow As Long, stopRow As Long
+    Dim startStr As String, stopStr As String
+
+    ' Cope with empty textboxes
+    If TBxHeaderStart.Value = "" Then
+        startStr = "0"
+    Else
+        startStr = TBxHeaderStart.Value
+    End If
+
+    If TBxHeaderStop.Value = "" Then
+        stopStr = "0"
+    Else
+        stopStr = TBxHeaderStop.Value
+    End If
+
+    ' Default to failure
+    checkHeaderRowValues = False
+
+    On Error Resume Next
+        startRow = CInt(startStr)
+        stopRow = CInt(stopStr)
+    errNum = Err.Number: Err.Clear: On Error GoTo 0
+
+    ' One or more non-numeric values
+    If errNum <> 0 Then Exit Function
+
+    ' Might as well make it so an empty start row means row 1
+    startRow = Application.worksheetfunction.Max(1, startRow)
+
+    ' Value check
+    If startRow > stopRow Then Exit Function
+
+    ' Checks ok; return True
+    checkHeaderRowValues = True
+
+End Function
 
+Private Sub setHeaderTBxColors()
+    ' Helper encapsulating the color setting logic
+    If checkHeaderRowValues Then
+        TBxHeaderStart.ForeColor = RGB(0, 0, 0)
+        TBxHeaderStop.ForeColor = RGB(0, 0, 0)
+    Else
+        TBxHeaderStart.ForeColor = RGB(255, 0, 0)
+        TBxHeaderStop.ForeColor = RGB(255, 0, 0)
+    End If
+
+End Sub
 ' =====  HELPER FUNCTIONS  =====
 
 Private Sub writeCSV(dataRg As Range, tStrm As TextStream, nFormat As String, _
-                    Separator As String)
+                    Separator As String, overrideHidden As Boolean)
 
     ' Encapsulates the process of actually writing the selected data to
     ' CSV on-disk.
@@ -387,7 +554,7 @@ Private Sub writeCSV(dataRg As Range, tStrm As TextStream, nFormat As String, _
     ' Loop
     For idxRow = 1 To dataRg.Rows.Count
         ' Only output visible rows unless hidden output indicated
-        If ChBxHiddenRows.Value Or Not dataRg.Cells(idxRow, 1).EntireRow.Hidden Then
+        If overrideHidden Or ChBxHiddenRows.Value Or Not dataRg.Cells(idxRow, 1).EntireRow.Hidden Then
             ' Reset the working string
             workStr = ""
 
@@ -455,3 +622,4 @@ Private Function isSeparatorInData(dataRg As Range, nFormat As String, _
     Next cel
 End Function
 
+