Attribute VB_Name = "Module1"
Option Explicit
Public StrJG As String  '存儲答題結果
Public UserN As String
Public UserS As String
Public UserA As String
Public UserL As String
Public UserD As String
Public UserT As String
Public UserCC As String
Public UserDC As String
Public Conn As New ADODB.Connection
Public Rs1 As New ADODB.Recordset
Function JiSuan(ByVal Str As String) As String  '計算每項得分
Dim i, j As Long
Dim Str1 As String
Dim StrT As String
Dim t As Long
Str = JS1(Str)
For i = 1 To Len(Str) Step 10
StrT = Mid(Str, i, 10)
t = 0
For j = 1 To 13
t = t + Val(Mid(StrT, j, 1))
Next
Str1 = Str1 + Format(t, "00")
Next
JiSuan = Str1
End Function
Function JS1(Str As String) As String   '將字符串排序
Dim Str1 As String
Str1 = Str1 + Mid(Str, 1, 1) + Mid(Str, 14, 1) + Mid(Str, 27, 1) + Mid(Str, 40, 1) + Mid(Str, 54, 1) + Mid(Str, 67, 1) + Mid(Str, 80, 1) + Mid(Str, 93, 1) + Mid(Str, 106, 1) + Mid(Str, 119, 1)
Str1 = Str1 + Mid(Str, 2, 1) + Mid(Str, 15, 1) + Mid(Str, 28, 1) + Mid(Str, 41, 1) + Mid(Str, 55, 1) + Mid(Str, 68, 1) + Mid(Str, 81, 1) + Mid(Str, 94, 1) + Mid(Str, 107, 1) + Mid(Str, 120, 1)
Str1 = Str1 + Mid(Str, 4, 1) + Mid(Str, 17, 1) + Mid(Str, 30, 1) + Mid(Str, 43, 1) + Mid(Str, 57, 1) + Mid(Str, 70, 1) + Mid(Str, 83, 1) + Mid(Str, 96, 1) + Mid(Str, 109, 1) + Mid(Str, 122, 1)
Str1 = Str1 + Mid(Str, 6, 1) + Mid(Str, 19, 1) + Mid(Str, 32, 1) + Mid(Str, 45, 1) + Mid(Str, 59, 1) + Mid(Str, 72, 1) + Mid(Str, 85, 1) + Mid(Str, 98, 1) + Mid(Str, 111, 1) + Mid(Str, 124, 1)
Str1 = Str1 + Mid(Str, 8, 1) + Mid(Str, 21, 1) + Mid(Str, 34, 1) + Mid(Str, 47, 1) + Mid(Str, 61, 1) + Mid(Str, 74, 1) + Mid(Str, 87, 1) + Mid(Str, 100, 1) + Mid(Str, 113, 1) + Mid(Str, 126, 1)
Str1 = Str1 + Mid(Str, 10, 1) + Mid(Str, 23, 1) + Mid(Str, 36, 1) + Mid(Str, 49, 1) + Mid(Str, 63, 1) + Mid(Str, 76, 1) + Mid(Str, 89, 1) + Mid(Str, 102, 1) + Mid(Str, 115, 1) + Mid(Str, 128, 1)
Str1 = Str1 + Mid(Str, 12, 1) + Mid(Str, 25, 1) + Mid(Str, 38, 1) + Mid(Str, 51, 1) + Mid(Str, 65, 1) + Mid(Str, 78, 1) + Mid(Str, 91, 1) + Mid(Str, 104, 1) + Mid(Str, 117, 1) + Mid(Str, 130, 1)
Str1 = Str1 + Mid(Str, 13, 1) + Mid(Str, 26, 1) + Mid(Str, 39, 1) + Mid(Str, 52, 1) + Mid(Str, 53, 1) + Mid(Str, 66, 1) + Mid(Str, 79, 1) + Mid(Str, 92, 1) + Mid(Str, 105, 1) + Mid(Str, 118, 1)
Str1 = Str1 + Mid(Str, 3, 1) + Mid(Str, 16, 1) + Mid(Str, 29, 1) + Mid(Str, 42, 1) + Mid(Str, 56, 1) + Mid(Str, 69, 1) + Mid(Str, 82, 1) + Mid(Str, 95, 1) + Mid(Str, 108, 1) + Mid(Str, 121, 1)
Str1 = Str1 + Mid(Str, 5, 1) + Mid(Str, 18, 1) + Mid(Str, 31, 1) + Mid(Str, 44, 1) + Mid(Str, 58, 1) + Mid(Str, 71, 1) + Mid(Str, 84, 1) + Mid(Str, 97, 1) + Mid(Str, 110, 1) + Mid(Str, 123, 1)
Str1 = Str1 + Mid(Str, 7, 1) + Mid(Str, 20, 1) + Mid(Str, 33, 1) + Mid(Str, 46, 1) + Mid(Str, 60, 1) + Mid(Str, 73, 1) + Mid(Str, 86, 1) + Mid(Str, 99, 1) + Mid(Str, 112, 1) + Mid(Str, 125, 1)
Str1 = Str1 + Mid(Str, 9, 1) + Mid(Str, 22, 1) + Mid(Str, 35, 1) + Mid(Str, 48, 1) + Mid(Str, 62, 1) + Mid(Str, 75, 1) + Mid(Str, 88, 1) + Mid(Str, 101, 1) + Mid(Str, 114, 1) + Mid(Str, 127, 1)
Str1 = Str1 + Mid(Str, 11, 1) + Mid(Str, 24, 1) + Mid(Str, 37, 1) + Mid(Str, 50, 1) + Mid(Str, 64, 1) + Mid(Str, 77, 1) + Mid(Str, 90, 1) + Mid(Str, 103, 1) + Mid(Str, 116, 1) + Mid(Str, 129, 1)
JS1 = Str1
End Function
Function JS2(Str As String) As String   '計算每項不知道的個數
Dim i, j As Long
Dim n As Long
Dim SSS As String
Str = JS1(Str)
For i = 0 To 12
SSS = Mid(Str, i * 10 + 1, 10)
For j = 1 To 10
If Mid(SSS, j, 1) = 1 Then n = n + 1
Next
JS2 = JS2 + Format(n, "0")
n = 0
Next
End Function
Function JSS(Str As String) As String   '性向測試得分
Dim i As Long
Dim tt As Long
Dim SS As String
tt = Val(Mid(Str, 1, 2))
Select Case tt  '思考性
Case 0, 1, 2, 3, 4: i = 1
Case 5, 6, 7, 8: i = 2
Case 9, 10, 11, 12: i = 3
Case 13, 14, 15, 16: i = 4
Case 17, 18, 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 3, 2))
Select Case tt  '共鳴性
Case 1, 2, 3, 4, 5, 6, 7, 8: i = 1
Case 9, 10, 11, 12: i = 2
Case 13, 14, 15: i = 3
Case 16, 17: i = 4
Case 18, 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 5, 2))
Select Case tt  '自律性
Case 0, 1, 2, 3, 4, 5: i = 1
Case 6, 7, 8, 9, 10: i = 2
Case 11, 12, 13, 14: i = 3
Case 15, 16, 17: i = 4
Case 18, 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 7, 2))
Select Case tt  '活動性
Case 0, 1, 2, 3, 4, 5, 6, 7: i = 1
Case 8, 9, 10, 11: i = 2
Case 12, 13, 14, 15: i = 3
Case 16, 17, 18: i = 4
Case 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 9, 2))
Select Case tt  '指導性
Case 0, 1, 2, 3, 4, 5: i = 1
Case 6, 7, 8, 9, 10: i = 2
Case 11, 12, 13, 14: i = 3
Case 15, 16, 17: i = 4
Case 18, 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 11, 2))
Select Case tt  '社交性
Case 0, 1, 2, 3, 4, 5: i = 1
Case 6, 7, 8, 9, 10: i = 2
Case 11, 12, 13, 14, 15: i = 3
Case 16, 17, 18, 19: i = 4
Case 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 13, 2))
Select Case tt  '創造性
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10: i = 1
Case 11, 12, 13: i = 2
Case 13, 14, 15, 16: i = 3
Case 17, 18, 19: i = 4
Case 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 15, 2))
Select Case tt  '成就性
Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9: i = 1
Case 10, 11, 12: i = 2
Case 13, 14, 15, 16: i = 3
Case 17, 18: i = 4
Case 19, 20: i = 5
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 17, 2))
Select Case tt  '變易性
Case 0, 1, 2, 3: i = 5
Case 4, 5, 6, 7: i = 4
Case 8, 9, 10, 11: i = 3
Case 12, 13, 14, 15: i = 2
Case 16, 17, 18, 19, 20: i = 1
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 19, 2))
Select Case tt  '抑郁性
Case 0, 1, 2, 3, 4: i = 5
Case 5, 6, 7, 8: i = 4
Case 9, 10, 11, 12, 13, 14: i = 3
Case 15, 16, 17: i = 2
Case 18, 19, 20: i = 1
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 21, 2))
Select Case tt  '神經質
Case 0, 1, 2, 3, 4, 5: i = 5
Case 6, 7, 8: i = 4
Case 9, 10, 11, 12: i = 3
Case 13, 14, 15, 16: i = 2
Case 17, 18, 19, 20: i = 1
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 23, 2))
Select Case tt  '自卑性
Case 0, 1, 2, 3: i = 5
Case 4, 5, 6, 7, 8: i = 4
Case 9, 10, 11, 12, 13: i = 3
Case 14, 15, 16, 17: i = 2
Case 18, 19, 20: i = 1
End Select
SS = SS + Trim(Val(i))
tt = Val(Mid(Str, 25, 2))
Select Case tt  '虛構性
Case 0, 1, 2, 3, 4, 5: i = 5
Case 6, 7, 8: i = 4
Case 9, 10, 11, 12: i = 3
Case 13, 14, 15, 16: i = 2
Case 17, 18, 19, 20: i = 1
End Select
SS = SS + Trim(Val(i))
JSS = SS
End Function
Function ZH(Str As String) As Long  '綜合判定總分
Dim i As Long
Dim t As Long
For i = 1 To 12
t = t + Val(Mid(Str, i, 1))
Next
ZH = t
End Function

Function My_Format(SS As String, ii As Long) As String
My_Format = SS & Space(ii - LenB(StrConv(SS, vbFromUnicode)))
End Function