分散對齊,空值每行數量,並處理文本中部分符號及尾部對齊

Andy Si
想請教一下,如何套用?
-------------------------
'利用access textbox(64位) 分散對齊,空值每行數量,並處理文本中部分符號及尾部對齊。需要自己確定文本長度。
Function GetCharLen(pChar() As Byte) As Long
GetCharLen = 1 - (pChar(1) <> 0)

End Function

Function AlignBothEnds(text_name As Variant, number As Integer)
Dim myStr As String
Dim Length As Long
Dim arrStr() As String
Dim tmpLen As Long
Dim tmpBit As Long
Dim Idx As Long
Dim i As Long
Dim Fcharacters As Variant
Dim TempByte() As Byte
Dim Nullspaces As Integer
Dim Numvalues As Variant
On Error GoTo dygs_Err
Fcharacters = ",.:;?:,。;、!:?" '開頭不可以出現的符號********
myStr = text_name
Length = Len(myStr)
ReDim arrStr(Length * 2)
For i = 1 To Length
tmpBit = i
tmpLen = 0
Do
tmpLen = tmpLen + GetCharLen(Mid(myStr, i, 1))
i = i + 1
Loop Until tmpLen >= number or i > Length
If tmpLen > number Then i = i - 1
If InStr(Fcharacters, Right(Mid(myStr, tmpBit, i - tmpBit + 1), 1)) <> 0 And _
InStr(Fcharacters, Left(Mid(myStr, tmpBit, i - tmpBit), 1)) <> 0 Then
arrStr(Idx) = Mid(myStr, tmpBit + 1, i - tmpBit + 1)
Else
If InStr(Fcharacters, Right(Mid(myStr, tmpBit, i - tmpBit + 1), 1)) <> 0 Then
arrStr(Idx) = Mid(myStr, tmpBit, i - tmpBit + 1)
Else
If InStr(Fcharacters, Left(Mid(myStr, tmpBit, i - tmpBit), 1)) <> 0 Then
arrStr(Idx) = Mid(myStr, tmpBit + 1, i - tmpBit)
Else
arrStr(Idx) = Mid(myStr, tmpBit, i - tmpBit)
End If
End If
End If
Idx = Idx + 1
i = i - 1
Next i

ReDim Preserve arrStr(Idx)

'==========================================================
'尾端資料對齊,判斷陣列最後一行字串數量並添加空值。
TempByte = Mid(myStr, tmpBit, i)
If (UBound(TempByte) + 1) > number Then
Nullspaces = number - (UBound(TempByte) + 1) Mod number
Else
Nullspaces = number - (UBound(TempByte) + 1)
End If

For Z = 1 To Nullspaces
Numvalues = Numvalues & Chr(2)
Next
AlignBothEnds = Left(Join(arrStr, vbCrLf), Len(Join(arrStr, vbCrLf)) - 1) & Numvalues
dygs_Exit:
Exit Function
dygs_Err:
MsgBox Error$
Resume dygs_Exit

End Function
Private Sub Command1_Click()
Text2 = AlignBothEnds(Text1, 63)
End Sub




回到頂部