16 Dec 2016

VBA Macro to Export Data from Excel Spreadsheet to CSV

Resources: http://stackoverflow.com/questions/13496686/how-to-save-semi-colon-delimited-csv-file-using-vba
and: http://stackoverflow.com/questions/35655426/excel-vba-finding-recording-user-selection

Sub Export_CSV()

    'author:    kay cichini
    'date:      26102014
    'update:    16122016
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    ' !!NOTE!!  files with same name and path will be overwritten
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    Set WB1 = ActiveWorkbook

    '(1) either used range in active sheet..
    '(2) or alternatively, user selected input range:
    Dim rng As Range
    Set rng = Application.InputBox("select cell range with changes", "Cells to be copied", Default:="Select Cell Range", Type:=8)
    Application.ScreenUpdating = False

    Set WB2 = Application.Workbooks.Add(1)
    WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    MyFileName = "CSV_Export_" & Format(Date, "ddmmyyyy")
    FullPath = WB1.Path & "\" & MyFileName
    Application.DisplayAlerts = False
    If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
    "Warning: Files in directory with same name will be overwritten!!", vbQuestion + vbYesNo) <> vbYes Then
        Exit Sub
    End If
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    With WB2
        .SaveAs Filename:=FullPath, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    Application.DisplayAlerts = True
End Sub

18 Oct 2016

Collect GPX-Files from Subdirectories and Convert to Single KML File

Reference: https://cran.r-project.org/web/packages/sp/vignettes/intro_sp.pdf


# here, m ygpx files reside in subdirectories..

files <- dir(pattern="*.gpx$", recursive = T, include.dirs = T)

# extract spatial lines
spl <- lapply(files, function(x) {readOGR(x, "tracks")@lines[[1]]} )

# apply ID to ID slot for latter merge with attribute data
for(i in 1:length(spl)) {slot(spl[[i]], "ID") <- as.character(i)}
tracksSL <- SpatialLines(spl, proj4string = CRS("+proj=longlat +datum=WGS84"))

# view data

# make dataframe for merging with spatial data
names <- sub("[.]gpx$", "", basename(files))
df <- data.frame(names = names, row.names = sapply(slot(tracksSL, "lines"), function(x) slot(x, "ID")))

# spatial dataframe
tracksSLDF <- SpatialLinesDataFrame(tracksSL, data = df)

# write ressult to KML
writeOGR(tracksSLDF, dsn="tracks_collection.kml", layer= "Wolfi_Garda_Tracks", driver="KML", dataset_options=c("NameField=names"))

6 Jul 2016

VBA Subroutine to Clear All Filters in Excel-Table

Sub filter_clear()

'author:    kay cichini
'date:      06072016
'purpose:   clear all filters in a preformated excel tabel

Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject

Set SelectedCell = ActiveCell

'Determine if ActiveCell is inside a Table
  On Error GoTo NoTableSelected
    TableName = SelectedCell.ListObject.Name
    Set ActiveTable = ActiveSheet.ListObjects(TableName)

    If ActiveTable.ShowAutoFilter Then
      'MsgBox "AutoFilters are turned on"
      If ActiveTable.AutoFilter.FilterMode Then
        'MsgBox "Filter is actually set"
      End If
    End If
  On Error GoTo 0

Exit Sub

'Error Handling
  MsgBox "There is no Table currently selected! (You need to activate a cell in the Table to be cleared!)", vbCritical

End Sub

23 Feb 2016

List Files Recursively and Write to File in Windows Shell

cd into the directory to be listed and then do:
dir /a-d /b /s > C:\WINDOWS\Temp\file_list.txt
start notepad C:\WINDOWS\Temp\file_list.txt

25 Jan 2016

HTML Legend for Corine Land Cover Classes

For anyone who might benefit from it, I'll post a HTML legend for CORINE Land Cover (CLC) Classes, which I tailored for HTML labelling of CLC-Rasters embeded in my QGIS via WMS.. Choose HTML, CSS or Result from the JSFiddle menu!