5 Nov 2014

VBA Macro to Export Data from Excel Spreadsheet to CSV

Sub Export_CSV()

    '***************************************************************************************
    'author:    kay cichini
    'date:      26102014
    'purpose:   export current spreadsheet to csv.file to the same file path as source file
    '
    ' !!NOTE!!  files with same name and path will be overridden
    '***************************************************************************************
  

    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    
    Set WB1 = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    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("Werte werden nach " & WB1.Path & "\" & MyFileName & " kopiert!" & vbCrLf & _
    "ACHTUNG: Dateien mit selbem Namen werden ├╝berschrieben!!", 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 True
    End With
    Application.DisplayAlerts = True
End Sub

4 Nov 2014

VBA Spreadsheet Function for Substring Inbetween Strings

Function Substring2(theString As String, str1 As String, repstr1 As Integer, Optional str2 As Variant, Optional repStr2 As Variant) As String

    '****************************************************************************************************************
    'author:    kay cichini
    'date:      04112014
    'purpose:   find substring deligned by the x-th repition of one string at the left side
    '           and anothers string x-th repition at the right side
    'str1:      first string to be matched
    'str2:      second string to be matched, optional
    'repstr1:   nth repition of str1 to be matched
    'repstr2:   nth repition of str2 to be matched, optional
    '           with optional arguments ommited function will return substring ending with the last character of the
    '           searchstring
    '----------------------------------------------------------------------------------------------------------------
    'example:   Substring2("1234 678 101214 xxxx"; " "; 2; "x"; 3)
    '           will match position 10 after the second repition of str1, find position 20 after the third "x"
    '           then apply a mid-function with signature 'mid(string, start, length)',
    '           where the position 10 is the start and length is position 20 - len("x") - 10 = 9
    '           and the result is "101214 xx"
    '****************************************************************************************************************
    
    Dim start1, start2, lenStr1, lenStr2, length As Integer
    
    If IsMissing(str2) And IsMissing(repStr2) Then
    
        'case when last char in string should be matched
        '-----------------------------------------------
        
        start1 = 1
        lenStr1 = Len(str1)
        
        If InStr(start1, theString, str1) = 0 Then
            '0 -> String couldn't be matched!
            Exit Function
        End If
        
        For i = 0 To repstr1 - 1
            start1 = InStr(start1, theString, str1) + lenStr1
        Next i
        
        length = Len(theString) - start1 + 1
        Substring2 = Mid(theString, start1, length)

    Else
    
        'other cases
        '-----------
        start1 = 1
        lenStr1 = Len(str1)
        start2 = 1
        lenStr2 = Len(str2)
        
        If InStr(start1, theString, str1) = 0 Or InStr(start2, theString, str2) = 0 Then
            '0 -> String couldn't be matched!
            Exit Function
        End If
        
        For i = 0 To repstr1 - 1
            start1 = InStr(start1, theString, str1) + lenStr1
        Next i
        
        For i = 0 To repStr2 - 1
            start2 = InStr(start2, theString, str2) + lenStr2
        Next i

        length = start2 - lenStr2 - start1
        Substring2 = Mid(theString, start1, length)
        
    End If
    
End Function

26 Sep 2014

Make a KML-File from an OpenStreetMap Trail

Ever wished to use a trail on OSM on your GPS or smartphone? With this neat little R-Script this can easily be done. You'll just need to search OpenStreetMap for the ID of the trail (way), put this as argument to osmar::get_osm, convert to KML and you're good to go!




# get OSM data
library(osmar)
library(maptools)
  
rotewandsteig <- get_osm(way(166274005), full = T)
sp_rotewandsteig <- as_sp(rotewandsteig, what = "lines")
  
# convert to KML 
kmlLine(sp_rotewandsteig@lines[[1]], kmlfile = "rotewandsteig.kml",
        lwd = 3, col = "blue", name = "Rotewandsteig") 

# view it
shell.exec("rotewandsteig.kml")