'

'Date: 2012/04/10
'Author: xi wei cheng
'
'Option Explicit
 
'
' Comment: Copy activeCell's value to the clipboard.
' ShortCutKeys: Ctrl+C
'
Sub CopyCellValue2Clipboard()
 
    
    Dim cellVal As String
    Dim startStr, endStr As String
    
    startStr = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(2, "D").value
    endStr = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(2, "E").value
    cellVal = ActiveCell.value
    
 
    
    Dim template As String
    template = "{start}{content}{end}"
    
    Dim result As String
    result = Strings.Replace(template, "{start}", startStr)
    result = Strings.Replace(result, "{end}", endStr)
    result = Strings.Replace(result, "{content}", cellVal)
    
    'cellVal = CopyFilter(cellVal)
    
    Dim dataobj As DataObject
    Set dataobj = New DataObject
    dataobj.SetText result
    dataobj.PutInClipboard
    
End Sub
 
Function CopyFilter(value As String)
    
    Dim flg1, flg2 As String
    flg1 = "y"
    flg2 = "z"
    Dim index1, index2 As Integer
    index1 = Strings.InStr(1, value, flg1)
    index2 = Strings.InStr(1, value, flg2)
    
    Dim retVal As String
    retVal = Strings.Right(value, Len(value) - (index2))
    CopyFilter = retVal
End Function
 
'
'Open select sql create form.
'
Sub SelectSql_Click()
    
    'MsgBox "Begin."
    'SelectSQLForm.Show
End Sub
 
'
' Comment: Change the Japan item to English.
' ShortCutKeys: Ctrl+Shift+F
'
Sub ChangeJp2En()
    Dim ocell As Range
    Dim startIndex, activeIndex As Integer
    startIndex = 13
    
    activeIndex = ActiveCell.Row
    While Not Cells(activeIndex, ActiveCell.Column).value = ""
        startIndex = 13
        While Not Cells(startIndex, "B").value = ""
            If Cells(startIndex, "B").value = Cells(activeIndex, ActiveCell.Column).value Then
                Cells(activeIndex, ActiveCell.Column + 1).value = Cells(startIndex, "C").value
            End If
            startIndex = startIndex + 1
        Wend
        activeIndex = activeIndex + 1
    Wend
End Sub
 
'
' Comment: Insert the set value at the activeCell.
' ShortCutKeys: Ctrl+Q
'
Sub InsertSetValue()
 
    ActiveCell.value = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(4, "D").value
    
End Sub
 
'
' Comment: Copy current row and insert to the down location.
' ShortCutKeys: Ctrl+Shift+I
'
Sub CopyCurrentRowDown()
    Dim rowIndex As Integer
    rowIndex = ActiveCell.Row
    Dim currenRow, nexRow As String
    currenRow = rowIndex & ":" & rowIndex
    nexRow = (rowIndex + 1) & ":" & (rowIndex + 1)
    Rows(currenRow).Select
    Selection.Copy
    Rows(nexRow).Select
    Selection.Insert Shift:=xlDown
End Sub
 
 
'
' Comment: Copy current row data to clipboard.
' ShortCutKeys: Ctrl+X
'
Sub CopyCurrentRowData()
    Dim rowIndex As Integer
    rowIndex = ActiveCell.Row
    Dim currenRow, rowData As String
    currenRow = rowIndex & ":" & rowIndex
    'rowData = "//"
    rowData = ""
    Dim c As Range
    For Each c In ActiveSheet.Range(currenRow).Cells
        If Not c.value = "" Then
            rowData = (rowData & " " & c.value)
        End If
        
    Next
    Dim dataobj As DataObject
    Set dataobj = New DataObject
    dataobj.SetText rowData
    dataobj.PutInClipboard
End Sub
 
'
' Comment: Copy Selection row data to clipboard.
' ShortCutKeys: Ctrl+X
'
Sub CopySelectionRowData()
    
    Dim startStr, endStr, todoFlg As String
    
    startStr = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(6, "D").value
    'startStr = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").ComboBox1.value
    endStr = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(6, "E").value
    todoFlg = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(6, "G").value
    
    Dim r As Range
    Set r = Selection
    'Dim ws As Worksheet
    Dim c, c1 As Range
    Dim rowIndex As Integer
    Dim currenRow, rowData, rowsData As String
    rowsData = ""
    
    Dim count As Integer
    
    For Each c1 In r
        rowIndex = c1.Row
        currenRow = rowIndex & ":" & rowIndex
        rowData = ""
        count = 0
        For Each c In ActiveSheet.Range(currenRow).Cells
            If Not c.value = "" Then
                count = count + 1
                If count = 1 Then
                    rowData = (rowData & c.value)
                Else
                    rowData = (rowData & " " & c.value)
                End If
            End If
        Next
        If Not count = 0 Then
            rowData = startStr & rowData & endStr
        End If
        
        If todoFlg = "Y" And Strings.InStr(1, rowData, "yŠO•”ƒR[ƒhz") > 0 Then
            rowData = rowData & vbCrLf & "// TODO"
        End If
        
        rowsData = rowsData & rowData & vbCrLf
    Next
    rowsData = Strings.Left(rowsData, Len(rowsData) - 2)
    
    Dim dataobj As DataObject
    Set dataobj = New DataObject
    dataobj.SetText rowsData
    dataobj.PutInClipboard
    
End Sub
 
'
' Comment: Mapping Japan to English.
' ShortCutKeys: Ctrl+A
'
Sub Key2Value()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim c As Range
    For Each c In Workbooks("ProgramTools.xls").Worksheets("PropDic").Range("A:A").Cells
        If Not dict.exists(c.value) And Not c.value = "" Then
            dict.Add c.value, c.Offset(0, 1).value
        End If
    Next
    Dim val As String
    val = dict.item(ActiveCell.value)
    If val = "" Then
    
        k = dict.keys
        v = dict.items
        
        Dim i As Integer
        For i = 0 To dict.count - 1
            If Strings.InStr(1, ActiveCell.value, k(i)) > 0 Then
                val = v(i)
                Exit For
            End If
        Next
    End If
    Dim dataobj As DataObject
    Set dataobj = New DataObject
    dataobj.SetText val
    dataobj.PutInClipboard
    If Not val = "" Then
        ActiveCell.value = ActiveCell.value & "[" & val & "]"
    End If
End Sub