Create a new version of paste: f7848a6a7

How to get rss fee...2 sec ago
Download Project X...MySQL | 13 sec ago
to call another ac...8 sec ago
UntitledPHP | 19 sec ago
Untitled13 sec ago
Setinterval and ge...15 sec ago
Untitled18 sec ago
Type lists in C#'s...21 sec ago

New Paste

Rem  *****  BASIC  *****
Sub TiddlyWikiExport()

' Dimension all variables
    Dim TableData As String
    Dim ColumnCount As Integer
    Dim RowCount As Integer
    Dim ClipboardData As New DataObject
       
    ' Loop for each row in selection
    For RowCount = 1 To Selection.Rows.Count
        
        ' Write the initial table tag
        TableData = TableData & "|"
    
        ' Loop for each column in selection
        For ColumnCount = 1 To Selection.Columns.Count

' Do header formatting for the first row
        If RowCount = 1 Then
            TableData = TableData & "!"
        Else
        
            ' Write the background color tag
            If Selection.Cells(RowCount, ColumnCount).Interior.Color <> vbWhite Then
                ColorToRGB CStr(Selection.Cells(RowCount, ColumnCount).Interior.Color), r, g, b
                TableData = TableData & "bgcolor(#" & r & g & b & "): "
            End If
    
            ' Write the initial bold tag
            If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
                TableData = TableData & "''"
            End If
    
            ' Write the initial italics tag
            If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
                TableData = TableData & "//"
            End If
    
            ' Write the initial strikethrough tag
            If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
                TableData = TableData & "---"
            End If
    
            ' Set right alignment
            If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlRight Or _
                Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
                TableData = TableData & " "
            End If
            
            ' Write the initial font color tag
            If Selection.Cells(RowCount, ColumnCount).Font.Color <> vbBlack Then
                ColorToRGB CStr(Selection.Cells(RowCount, ColumnCount).Font.Color), r, g, b
                TableData = TableData & "@@color(#" & r & g & b & "):"
            End If
            
            ' Write the initial hyperlink tag
            If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
                TableData = TableData & "[["
            End If
        End If
        
        ' Write current cell's text
@@        content = Replace(Selection.Cells(RowCount, ColumnCount).Text, Chr$(10), "<br>")
        TableData = TableData & content
        
        If RowCount <> 1 Then
           
           ' Write the initial hyperlink tag
           If Selection.Cells(RowCount, ColumnCount).Hyperlinks.Count > 0 Then
               TableData = TableData & "|" & Selection.Cells(RowCount, ColumnCount).Hyperlinks(1).Address & "]]"
           End If
        
           ' Write the ending font color tag
           If Selection.Cells(RowCount, ColumnCount).Font.Color <> vbBlack Then
               TableData = TableData & "@@"
           End If
           
           
           ' Set left alignment
           If Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlLeft Or _
               Selection.Cells(RowCount, ColumnCount).HorizontalAlignment = xlCenter Then
               TableData = TableData & " "
           End If
        
           ' Write the ending strikethrough tag
           If Selection.Cells(RowCount, ColumnCount).Font.Strikethrough = True Then
               TableData = TableData & "---"
           End If
        
           ' Write the ending italic tag
           If Selection.Cells(RowCount, ColumnCount).Font.Italic = True Then
               TableData = TableData & "//"
           End If
           
           ' Write the ending bold tag
           If Selection.Cells(RowCount, ColumnCount).Font.Bold = True Then
               TableData = TableData & "''"
           End If
        End If
        
        ' Write the ending table separator
        TableData = TableData & "|"
        
        ' Check if cell is in last column
        If ColumnCount = Selection.Columns.Count Then
            ' If so then write a blank line
            TableData = TableData & Chr$(10)
        End If

' Start next iteration of ColumnCount loop
        Next ColumnCount

' Start next iteration of RowCount loop
    Next RowCount
    
    ' Copy data to the clipboard
    ClipboardData.SetText TableData
    ClipboardData.PutInClipboard
End Sub

Sub ColorToRGB(ByVal Color As String, ByRef r, ByRef g, ByRef b)

On Error GoTo Solution
Dim SStr As String
SStr = "000000" & Hex(Color)
SStr = Right(SStr, 6)
b = Mid(SStr, 1, 2)
g = Mid(SStr, 3, 2)
r = Mid(SStr, 5, 2)

If Len(r) < 2 Then r = "0" & r
If Len(g) < 2 Then g = "0" & g
If Len(b) < 2 Then b = "0" & b
    
Solution:
    If Err.Number <> 0 Then
        r = -1
        g = -1
        b = -1
    End If
End Sub

Optional Paste Settings

Syntax Highlighting:

Paste Expiration:

Paste Exposure:

Paste Name / Title:

Hello Guest
Sign Up or Login

You are currently not logged in, this means you can not edit or delete anything you paste. Sign Up or Login

Pastebin.com Tools & Applications

Windows

Firefox

Chrome

iOS

WebOS

Android

Mac

Opera

Click.to

UNIX

WinPhone