Excel to DataTables example: Difference between revisions
From WickyWiki
mNo edit summary |
|||
| Line 127: | Line 127: | ||
header: function ( row ) { | header: function ( row ) { | ||
var data = row.data(); | var data = row.data(); | ||
return 'Details for '+data[<!--NAME COLUMN INDEX-->]; | |||
} | } | ||
} ), | } ), | ||
Revision as of 14:17, 28 July 2020
This example shows how to generate a DataTable (https://datatables.net) from an Excel document using a HTML template. It uses below features.
DataTables:
- Paging
- Modal detail form on row-click
- Search highlight
- Clear search button
- Column sorting
- Bootstrap 4
Excel macro:
- Row=1 is headers-row
- Clickable http links
- Clickable email link
- Skip columns with bracket-header [header] or empty
- Skip rows based on status-column with value 'x' or empty
Additional information:
- https://datatables.net
- https://datatables.net/extensions/responsive/examples/display-types/bootstrap4-modal.html
DataTable HTML template
Below is the HTML template, if contains an example table to be removed when used with the Excel macro.
Dom elements placement
l - length changing input control 'show N entries' f - filtering input 'Search' t - The table i - Table information summary 'Showing n1 to n2 of N entries' p - pagination control 'previous .. next' r - processing display element
About a bootstrap grid:
In a bootstrap grid, columns are 100% wide. Use col-<size>-<number> classes to override. <size> can be [xs, sm, md, lg] and corresponds with the screen width that is available. <number> is [1-12] and determines how many parts-in-width of a total of 12 you want for the element.
The HTML page, you can copy and paste this into an HTML file and open it in your browser. To use this together with the macro, use it as template.
<html>
<head>
<meta charset="UTF-8"/>
<meta http-equiv="Content-type" content="text/html; charset=UTF-8"/>
<title><!--TITLE--></title>
<script src="https://code.jquery.com/jquery-3.4.1.min.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.3/umd/popper.min.js"></script>
<script src="https://cdn.datatables.net/1.10.20/js/jquery.dataTables.min.js"></script>
<script src="https://johannburkard.de/resources/Johann/jquery.highlight-5.closure.js"></script>
<script src="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/4.1.3/js/bootstrap.min.js"></script>
<script src="https://cdn.datatables.net/1.10.20/js/dataTables.bootstrap4.min.js"></script>
<script src="https://cdn.datatables.net/buttons/1.6.1/js/dataTables.buttons.min.js"></script>
<script src="https://cdn.datatables.net/responsive/2.2.3/js/dataTables.responsive.min.js"></script>
<script src="https://cdn.datatables.net/responsive/2.2.3/js/responsive.bootstrap4.min.js"></script>
<link rel="stylesheet" type="text/css" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/4.1.3/css/bootstrap.css"/>
<link rel="stylesheet" type="text/css" href="https://cdn.datatables.net/1.10.20/css/dataTables.bootstrap4.min.css"/>
<link rel="stylesheet" type="text/css" href="https://cdn.datatables.net/responsive/2.2.3/css/responsive.bootstrap4.min.css"/>
<style>
div.dt-buttons {
float: right;
margin-left:1px;
}
.buttons-clear-search {
color: gray;
border-radius: 3px;
border: 1px solid rgb(206, 212, 218);
padding: 1;
width: 31px;
height: 31px;
}
div.dataTables_filter {
float: right;
}
.highlight { background-color: yellow }
</style>
</head>
<body>
<h4><!--TITLE--></h4>
<table id="table1" class="table table-striped table-bordered table-hover nowrap" style="width:100%">
<!--TABLE ROWS-->
</table>
<script type="text/javascript">
$.fn.dataTable.ext.buttons.custom = {
className: 'buttons-clear-search',
action: function ( e, dt, node, config ) {
dt.columns().search('');
dt.search('').draw();
//button-text=this.text()
}
};
$(document).ready( function () {
var table = $('#table1').DataTable( {
dom:
"<'row'<'col-sm-6 col-md-6'l><'col-sm-6 col-md-6'fB>>" +
"<'row'<'col-sm-6 col-md-5'i><'col-sm-6 col-md-7'p>>" +
"<'row'<'col-sm-12'tr>>",
language: {
search: "",
searchPlaceholder: "Search"
},
order: [], //disable initial sorting
buttons: [
{
extend: 'custom',
text: 'x'
//key: { key: String.fromCharCode(27) } //escape key
}
],
responsive: {
details: {
type: 'column',
target: 'tr', // row-click
//Note: modal does not trigger when all columns are visible
display: $.fn.dataTable.Responsive.display.modal( {
header: function ( row ) {
var data = row.data();
return 'Details for '+data[<!--NAME COLUMN INDEX-->];
}
} ),
renderer: $.fn.dataTable.Responsive.renderer.tableAll( { tableClass: 'table' } )
//custom renderer: https://datatables.net/extensions/responsive/examples/child-rows/custom-renderer.html
}
}
} );
table.on( 'select', function ( e, dt, type, indexes ) {
//if not responsive view launch responsive modal
});
//highlight within table (if any results)
table.on( 'draw', function () {
var body = $( table.table().body() );
body.removeHighlight();
if ( table.rows( { filter: 'applied' } ).data().length ) {
body.highlight( table.search() );
}
} );
//highlight after modal display
table.on('click', 'tr', function () {
$('body').find(".modal-body").highlight( table.search() );
});
//read parameters
var getUrlParameter = function getUrlParameter(sParam) {
var sPageURL = window.location.search.substring(1),
sURLVariables = sPageURL.split('&'),
sParameterName, i;
for (i = 0; i < sURLVariables.length; i++) {
sParameterName = sURLVariables[i].split('=');
if (sParameterName[0] === sParam) {
return sParameterName[1] === undefined ? true : decodeURIComponent(sParameterName[1]);
}
}
};
//search, http://...?q=<value>
var paramValQ = getUrlParameter('q');
if (paramValQ && paramValQ != '') {
//alert('q='+paramValQ);
table.search(paramValQ).draw();
}
//search, ID-column exact match, http://...?ID=<value>
var paramValId = getUrlParameter('ID');
if (paramValId && paramValId != '') {
$.each(table.columns().header(), function(key, value) {
if ( $(value).html() == 'ID') {
var column = table.columns(key);
column.search('^'+paramValId+'$', true, false).draw();
//show first row as modal
$('tr td:first-child').click();
return false;
}
} );
}
} );
</script>
<p>
<i><!--FILENAME--></i><br/>
<i><!--DATE AND TIME--></i>
</p>
<p>
Help:
<ul>
<li>Click on a row for detailview or use direct-link: http://[this page]?ID=[value]</li>
<li>Type text in the Search box to filter rows or use direct-link: http://[this page]?q=[value]</li>
<li>Click column titles to sort</li>
</ul>
</p>
</body>
</html>
Libre Office Basic Script
This macro generates HTML table rows from a spreadsheet (Calc) document to be inserted into the HTML template.
Sub SheetToHTMLDataTable()
'settings sheet
wsSettings = thisComponent.getSheets().getByName("Settings")
templateText = wsSettings.getCellrangeByName("B1").getString()
tableSheetName = wsSettings.getCellrangeByName("B2").getString()
searchLabelColumn = wsSettings.getCellrangeByName("B3").getString()
searchIDColumn = wsSettings.getCellrangeByName("B4").getString()
'table sheet
wsTable = thisComponent.getSheets().getByName(tableSheetName)
'outputfile (based on macro workbook location)
outputFile = ThisComponent.getLocation() & ".html"
'template
'replace EOL marker, it didn't seem possible to paste EOL in a cell
templateText = Replace(templateText, "/r/n", chr$(10), 1, -1, FALSE)
'date and time
dateTimeText = Format(Now, "dd mmm yyyy, hh:mm")
templateText = Replace(templateText, "<!--DATE AND TIME-->", dateTimeText, 1, -1, FALSE)
'filename
templateText = Replace(templateText, "<!--FILENAME-->", ThisComponent.getLocation(), 1, -1, FALSE)
'title
GlobalScope.BasicLibraries.LoadLibrary("Tools")
templateText = Replace(templateText, "<!--TITLE-->", FileNameoutofPath(GetFileNameWithoutExtension(ThisComponent.getLocation())), 1, -1, FALSE)
'table
tableText = ToHTMLTable(wsTable, searchLabelColumn, searchIDColumn)
templateText = Replace(templateText, "<!--TABLE ROWS-->", tableText, 1, -1, FALSE)
'details label
templateText = Replace(templateText, "<!---NAME COLUMN INDEX-->","0", 1, -1, FALSE)
'results
wsSettings.getCellrangeByName("B5").setString(outputFile)
wsSettings.getCellrangeByName("B6").setString(dateTimeText)
'write to file
WriteToFile(outputFile,templateText)
End Sub
Public Sub WriteToFile(filename, val)
On Error Goto writeFileError
mySf = createUnoService("com.sun.star.ucb.SimpleFileAccess")
myTextFile = createUnoService("com.sun.star.io.TextOutputStream")
If mySf.exists(filename) Then
mySf.kill(filename)
End If
myFileStream = mySf.openFileWrite(filename)
myTextFile.OutputStream = myFileStream
myTextFile.Encoding = "UTF-8"
myTextFile.writeString(val)
myFileStream.closeOutput : myTextFile.closeOutput
On Error Goto 0
Exit Sub
writeFileError:
On Error Resume Next
myFileStream.closeOutput : myTextFile.closeOutput
On Error Goto 0
End Sub
Public Function EscapeChars(val) As String
val = Replace(val, "&", "&")
val = Replace(val, "<", "<")
val = Replace(val, ">", ">")
EscapeChars = val
End Function
Public Function ToHTMLTable(ws, searchLabelColumn, searchIDColumn) As String
Dim maxRowIdx As Integer
Dim colIdx As Integer
Dim colName As String
newLine = Chr$(10)
dblQoute = """"
ins1 = Chr$(9)
ins2 = ins1 & ins1
ins3 = ins2 & ins1
ins4 = ins3 & ins1
'Declare variables
colIdxID = -1
colIdxLabel = 0
'Max area
Dim oCursor As Variant
oCursor = ws.createCursor()
oCursor.gotoEndOfUsedArea(False)
maxColIdx = oCursor.RangeAddress.EndColumn
maxRowIdx = oCursor.RangeAddress.EndRow
'headings (rowIdx=1)
tHead = ins2 & "<tr> " & newLine
For colIdx = 0 To maxColIdx
colName = ws.getCellByPosition(colIdx,0).getString()
'find column indexes for ID and LABEL
If colIdxID = 0 And InStr(1, colName, searchIDColumn) > 0 Then
colIdxID = colIdx
ElseIf colIdxLabel = 0 And InStr(1, colName, searchLabelColumn) Then
colIdxLabel = colIdx
End If
'if not skip Column
If colName <> "" Then
tHead = tHead & ins3 & "<th>" & Replace(colName, "<", "<") & "</th>" & newLine
End If
Next colIdx
'email link column
tHead = tHead & ins3 & "<th>e-mail</th>" & newLine
'close head
tHead = tHead & ins2 & "</tr>" & newLine
'loop over rows, row 0 is heading
tBody = ""
For rowIdx = 1 To maxRowIdx
If colIdxID>=0 Then
valID = EscapeChars(ws.getCellByPosition(colIdxID,1).getString())
Else
valID = rowIdx
End If
valLabel = EscapeChars(ws.getCellByPosition(colIdxLabel,1).getString())
If valLabel <> "" Then
tBody = tBody & ins2 & "<tr> " & newLine
For colIdx = 0 To maxColIdx
colName = ws.getCellByPosition(colIdx,0).getString()
cellVal = EscapeChars(ws.getCellByPosition(colIdx,rowIdx).getString())
'skip Column
If colName <> "" Then
If Left(cellVal, 4) = "http" Then
'http link
tBody = tBody & ins3 & "<td><a target=_blank href=" & dblQoute & cellVal & dblQoute & ">link</a></td>" & newLine
Else
'other
tBody = tBody & ins3 & "<td>" & Replace(cellVal, "<", "<") & "</td>" & newLine
End If
End If
Next colIdx
'email link column
tBody = tBody & ins3 & "<td><a target=_blank href=" & dblQoute & "mailto:mail@me.pls?subject=" & valLabel & " (Ref." & valID & ")" & "&body=Your message here," & dblQoute & ">mail</a></td>" & newLine
tBody = tBody & ins2 & "</tr>" & newLine
End If
Next rowIdx
'Return html format
ToHTMLTable = "<thead>" & tHead & "</thead>" & newLine & "<tbody>" & tBody & "</tbody>" & newLine & "<tfoot>" & tHead & "</tfoot>"
End Function
Microsoft Excel Visual Basic Script (VBA)
This Excel macro generates HTML table rows from an Excel document to be inserted into the HTML template.
' global variables
Dim glob_mwb As Excel.Workbook
Dim glob_mws As Excel.Worksheet
Dim glob_inputFilename As String
Dim glob_colIdx_id As Integer
Dim glob_colIdx_name As Integer
'ranges to show selected and created files
Dim inputNameR As Excel.Range
Dim templateR As Excel.Range
Dim outputNameR As Excel.Range
' html template placeholders
Const matchHtmlTableRows = "<!--TABLE ROWS-->"
Const matchDateAndTime = "<!--DATE AND TIME-->"
Const matchFileName = "<!--FILENAME-->"
Const matchNameColumnIndex = "<!--NAME COLUMN INDEX-->"
Const matchTitle = "<!--TITLE-->"
' excel open and proces file (start here)
Sub SelectOpenAndFormat()
Dim wb As Excel.Workbook
Dim y As Integer
Dim x As Integer
Dim openResult As Integer
'macro workbook/worksheet
Set glob_mwb = Application.ActiveWorkbook
Set glob_mws = Application.ActiveSheet
'init glob ranges
Set inputNameR = glob_mws.Range("B12")
Set templateR = glob_mws.Range("B15")
Set outputNameR = glob_mws.Range("B18")
'Select file
openResult = OpenFileDialog()
inputNameR.Value = glob_inputFilename
If openResult <> 0 Then
Set wb = Workbooks.Open(glob_inputFilename)
End If
If Not wb Is Nothing Then
CreateHTMLfile wb
wb.Close
End If
End Sub
' excel open file dialog
Function OpenFileDialog() As Integer
Dim intChoice As Integer
Dim strPath As String
'select dir
Application.FileDialog(msoFileDialogOpen).InitialFileName = Application.ActiveWorkbook.Path
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
Application.FileDialog(msoFileDialogOpen).Filters.Clear
Application.FileDialog(msoFileDialogOpen).Filters.Add "Excel", "*.xlsx"
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
'return filename
glob_inputFilename = strPath
End If
OpenFileDialog = intChoice
End Function
'Following function converts Excel range to HTML table
Public Function ConvertRangeToHTMLrows(ws As Worksheet) As String
newLine = Chr$(10)
dblQoute = """"
ins1 = Chr$(9)
ins2 = ins1 & ins1
ins3 = ins2 & ins1
ins4 = ins3 & ins1
'Declare variables
glob_colIdx_name = 1
glob_colIdx_id = 1
'Find the last non-blank cell in column A(1)
maxRowIdx = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1
maxColIdx = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'headings (rowIdx=1)
tHead = ins2 & "<tr> " & newLine
For colIdx = 1 To maxColIdx
colName = ws.Cells(1, colIdx).Text
'find column indexes
If glob_colIdx_id <= 1 And InStr(1, colName, "id", vbTextCompare) > 0 Then
glob_colIdx_id = colIdx
ElseIf glob_colIdx_name <= 1 And (InStr(1, colName, "naam", vbTextCompare) > 0 Or InStr(1, colName, "name", vbTextCompare)) Then
glob_colIdx_name = colIdx
End If
'if not skip Column
If Left(colName, 1) <> "[" And colName <> "" Then
tHead = tHead & ins3 & "<th>" & Replace(colName, "<", "<") & "</th>" & newLine
End If
Next colIdx
'email link column
tHead = tHead & ins3 & "<th>Comments</th>" & newLine
'close head
tHead = tHead & ins2 & "</tr>" & newLine
'loop over each row in the range A2..
tBody = ""
For rowIdx = 2 To maxRowIdx
'Col A = ID (glob_colIdx_id)
'Skip row ID<0
valID = ws.Cells(rowIdx, glob_colIdx_id).Text
valNaam = ws.Cells(rowIdx, glob_colIdx_name).Text
If valID <> "" And valID >= 0 Then
tBody = tBody & ins2 & "<tr> " & newLine
For colIdx = 1 To maxColIdx
colName = ws.Cells(1, colIdx).Text
cellVal = ws.Cells(rowIdx, colIdx).Text
'escape
cellVal = Replace(cellVal, "<", "<")
cellVal = Replace(cellVal, ">", ">")
cellVal = Replace(cellVal, "&", "&")
'skip Column
If Left(colName, 1) <> "[" And colName <> "" Then
If Left(cellVal, 4) = "http" Then
'http link
tBody = tBody & ins3 & "<td><a target=_blank href=" & dblQoute & cellVal & dblQoute & ">link</a></td>" & newLine
Else
'other
tBody = tBody & ins3 & "<td>" & Replace(cellVal, "<", "<") & "</td>" & newLine
End If
End If
Next colIdx
'email link column
tBody = tBody & ins3 & "<td><a target=_blank href=" & dblQoute & "mailto:mail@me.pls?subject=" & valNaam & " (Ref." & valID & ")" & "&body=Your message here," & dblQoute & ">mail</a></td>" & newLine
tBody = tBody & ins2 & "</tr>" & newLine
End If
Next rowIdx
'Return html format
ConvertRangeToHTMLrows = "<thead>" & tHead & "</thead>" & newLine & "<tbody>" & tBody & "</tbody>" & newLine & "<tfoot>" & tHead & "</tfoot>"
End Function
Sub CreateHTMLfile(wb As Excel.Workbook)
'outputfile (based on macro workbook location)
outputFile = glob_mwb.Path & "\" & Replace(Replace(wb.Name, ".xlsx", ".html"), ".xls", ".html")
'read template & save to file
nameTitle = wb.Name
wb.Activate
Dim ws As Worksheet
Dim r As Range
Set ws = wb.ActiveSheet
templateText = templateR.Text
'generate html
If Not ws Is Nothing Then
templateText = Replace(templateText, matchHtmlTableRows, ConvertRangeToHTMLrows(ws), vbTextCompare)
templateText = Replace(templateText, matchDateAndTime, Format(DateTime.Now, "dd mmm yyyy, hh:mm"), vbTextCompare)
templateText = Replace(templateText, matchFileName, wb.FullName, vbTextCompare)
'templateText = Replace(templateText, matchNameColumnIndex, glob_htmlName_colIdx - 1, vbTextCompare)
templateText = Replace(templateText, matchTitle, nameTitle, vbTextCompare)
'write to file
Set fileLua = CreateObject("adodb.stream")
adTypeBinary = 2
adModeReadWrite = 3
adSaveCreateOverWrite = 2
fileLua.Type = adTypeBinary
fileLua.Mode = adModeReadWrite
fileLua.Charset = "UTF-8"
fileLua.Open
fileLua.WriteText templateText
fileLua.SaveToFile outputFile, adSaveCreateOverWrite
fileLua.Flush
fileLua.Close
glob_mws.Hyperlinks.Add outputNameR, outputFile
outputNameR.Value = outputFile
'ThisWorkbook.FollowHyperlink (outputFile)
End If
End Sub