'

'Date: 2012/04/10
'Author: xi wei cheng
'
'Option Explicit
 
Public dict As Object
 
'
' 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 addflg As Boolean
    addflg = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").CheckBox3.value
    
    Dim template As String
    template = "{start}{content}{end}"
    
    If Not addflg Then
        startStr = ""
        endStr = ""
    End If
    
    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 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
    
    Dim addflg, todoFlg As Boolean
    addflg = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").CheckBox1.value
    todoFlg = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").CheckBox2.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 And addflg Then
            rowData = startStr & rowData & endStr
        End If
        
        If todoFlg And Strings.InStr(1, rowData, "yŠO•”ƒR[ƒhz") > 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()
    If dict Is Nothing Then
        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
    End If
    
    Dim c1 As Range
    Dim valArr As String
    valArr = ""
    For Each c1 In Selection
        c1.Activate
        
        Dim val, cellVal As String
        cellVal = ActiveCell.value
        Dim i1, i2 As Integer
        i1 = Strings.InStr(1, cellVal, "[")
        i2 = Strings.InStr(1, cellVal, "]")
        If i1 > 0 And i2 > i1 Then
            cellVal = Left(cellVal, i1 - 1) & Right(cellVal, Len(cellVal) - i2)
        End If
        val = dict.item(cellVal)
        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
        valArr = valArr & val & vbCrLf
        If Not val = "" Then
            If Strings.InStr(1, ActiveCell.value, val) > 0 Then
                ActiveCell.value = Strings.Replace(ActiveCell.value, "[" & val & "]", "")
            Else
                ActiveCell.value = ActiveCell.value & "[" & val & "]"
            End If
        End If
    Next
    
    If valArr <> "" Then
        valArr = Strings.Left(valArr, Len(valArr) - 2)
    End If
    Dim dataObj As DataObject
    Set dataObj = New DataObject
    dataObj.SetText valArr
    dataObj.PutInClipboard
End Sub
 
 
'
' Comment: Copy Bean properties to another.
' ShortCutKeys: Ctrl+T
'
Sub CopyBeanProps()
    
    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 beanFrom, beanTo As String
    beanFrom = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(8, "D").value
    beanTo = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(8, "E").value
    
    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[ƒhz") > 0 Then
            rowData = rowData & vbCrLf & "// TODO"
        End If
        
        
        
        Dim indexB, indexE As Integer
        indexB = Strings.InStr(1, rowData, "[")
        indexE = Strings.InStr(2, rowData, "]")
        Dim idEn, FirstChUpperIdEn, codeStr As String
        idEn = Strings.Mid(rowData, indexB + 1, indexE - indexB - 1)
        FirstChUpperIdEn = UCase(Left(idEn, 1)) & Right(idEn, Len(idEn) - 1)
        
        'b1.setProp(b2.getProp());
        codeStr = beanTo & ".set" & FirstChUpperIdEn & "(" & beanFrom & ".get" & FirstChUpperIdEn & "());"
        
        rowData = Strings.Replace(rowData, "[" & idEn & "]", "")
        
        rowsData = rowsData & rowData & vbCrLf
        rowsData = rowsData & codeStr & 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: Make index for UT test items.
' ShortCutKeys: Ctrl+Shift+W
'
Sub MakeIndex()
 
    Dim joinIndex, cellVal, newVal As String
    joinIndex = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(9, "D").value
    Dim indexArr, rowArr, in0 As String
    indexArr = Split(joinIndex, ",")
    cellVal = ActiveCell.value
    rowArr = Split(cellVal, vbLf)
    newVal = ""
    in0 = 0
    
    For Each row In rowArr
        Dim in1 As Integer
        in1 = Strings.InStr(1, rowArr(in0), "D")
        If in1 > 0 Then
            Dim content As String
            content = Strings.Right(rowArr(in0), Len(rowArr(in0)) - in1)
            
            newVal = newVal & (indexArr(in0) & "D" & content & vbCrLf)
        End If
        in0 = in0 + 1
    Next
    newVal = Strings.Left(newVal, Len(newVal) - 2)
    'Dim dataobj As DataObject
    'Set dataobj = New DataObject
    'dataobj.SetText newVal
    'dataobj.PutInClipboard
    ActiveCell.value = newVal
End Sub
 
 
'
' Comment: Append index for UT test items.
' ShortCutKeys: Ctrl+W
'
Sub AppendIndex()
 
    Dim joinIndex, cellVal As String
    joinIndex = Workbooks("ProgramTools.xls").Worksheets("ExcelTools").Cells(9, "D").value
    Dim indexArr, rowArr, in0 As String
    indexArr = Split(joinIndex, ",")
    cellVal = ActiveCell.value
    rowArr = Split(cellVal, vbLf)
    in0 = 0
    
    For Each row In rowArr
        Dim in1 As Integer
        in1 = Strings.InStr(1, rowArr(in0), "D")
        If in1 > 0 Then
           in0 = in0 + 1
        End If
    Next
    ActiveCell.NumberFormatLocal = "@"
    If in0 <> 0 Then
        ActiveCell.value = cellVal & vbCrLf & indexArr(in0) & "D"
    Else
        ActiveCell.value = cellVal & indexArr(in0) & "D"
    End If
End Sub
 
 
Public Sub CompareHandle()
    UserForm1.Show
End Sub
 
 
Public Sub ExportSheetAsTxt()
    
    Call DoExportTxt(ActiveSheet)
    
End Sub
 
Sub DoExportTxt(ws As Worksheet)
 
    Dim lastRow, count As Integer
    lastRow = MaxRowIndex(ws)
    count = 0
    
    Dim row As Range
    Dim txt, txtRow, fileName As String
    txt = ""
    txtRow = ""
    
    For Each row In Rows
        If count > lastRow Then Exit For
        
        txtRow = GetRowData(row)
        txt = txt & txtRow & vbCrLf
        count = count + 1
    Next
    
    txt = Strings.Left(txt, Len(txt) - 2)
    
    fileName = ActiveWorkbook.Name & "_" & ws.Name & "_" & ReplaceAll(DateTime.Time, ":", "-") & ".txt"
    If MakeTxtFile(txt, fileName) Then
        MsgBox "Export txt file success!" & vbCrLf & vbCrLf & "FileName: yC:\ExportSheetTxtFiles\" & fileName & "z"
    End If
    
End Sub
 
Function ReplaceAll(str As String, src As String, dest As String)
    
    Dim index As Integer
    index = Strings.InStr(1, str, src)
    
    While index > 0
        str = Strings.Replace(str, src, dest)
        index = Strings.InStr(1, str, src)
    Wend
    ReplaceAll = str
    
End Function
 
Function IsFileExist(path As String)
    
    On Error GoTo EarlyExit
    
    If Not Dir(path, vbDirectory) = vbNullString Then
        IsFileExist = True
    End If
    
    Exit Function
 
EarlyExit:
    IsFileExist = False
    
End Function
 
Function MakeTxtFile(ByVal txt As String, ByVal fileName As String)
    
    'On Error GoTo msgLabel
    
    Dim MyFile As Object
 
    If Not IsFileExist("C:\ExportSheetTxtFiles\") Then
        MkDir "C:\ExportSheetTxtFiles\"
    End If
    
    Dim filePath As String
    filePath = "C:\ExportSheetTxtFiles\" & fileName
    Open filePath For Output As #1
    Print #1, txt
    Close #1
    Reset
    MakeTxtFile = True
    Exit Function
    
msgLabel:
    MsgBox "Make file failed! Maybe the file has bean opened!"
    MakeTxtFile = False
    
End Function
 
Function GetRowData(row As Range)
 
    Dim cell As Range
    Dim retVal As String
    retVal = ""
    Dim count, colCount1 As Integer
    count = 0
    colCount1 = row.Worksheet.Range("IV" & row.row).End(xlToLeft).Column
    
    For Each cell In row.Cells
        If count >= colCount1 Then Exit For
        
        If cell.value = "" Then
            retVal = retVal & " "
        Else
            retVal = retVal & cell.value
        End If
        
        count = count + 1
    Next
    GetRowData = retVal
    
End Function
 
Function MaxRowIndex(ws As Worksheet)
    
    Dim i, index, tempIndex As Integer
    index = 0
    
    For i = 1 To 100
        tempIndex = ws.Cells(65536, i).End(xlUp).row
        If tempIndex > index Then index = tempIndex
    Next
    MaxRowIndex = index
    
End Function