سوف نستكمل مهارات التقسيم للجمل فى الاكسيس
وسبق وتم شرح الكود التالى فى 3 ملفات فيديو
===========================
Attribute VB_Name = "Module1"
Option Compare Database
Option Explicit
================================
Function PartOfName(InName As String, NumberOfPart As Byte) As String
Dim TheSpaceNumber As Byte
Dim I As Integer, U As Integer
InName = NoSpaces1(InName)
PartOfName = ""
If InName = Null Then Exit Function
Do
U = I
I = InStr(I + 1, InName, " ", 1)
If I <> 0 Then
TheSpaceNumber = TheSpaceNumber + 1
If TheSpaceNumber = NumberOfPart Then Exit Do
ElseIf TheSpaceNumber + 1 = NumberOfPart Then
I = Len(InName) + 1
Exit Do
Else
Exit Function
End If
Loop
PartOfName = Trim(Mid(InName, U + 1, I - U - 1))
End Function
======================================================
Function NoSpaces(InName As String) As String
Dim NewName As String, ThePrevStr As String, TheStr As String
Dim I As Integer
InName = Trim(InName)
MsgBox InName & Chr(13) & NewName & Chr(13) _
& ThePrevStr & Chr(13) & TheStr & Chr(13) _
& Len(InName)
For I = 1 To Len(InName)
TheStr = Mid(InName, I, 1)
If TheStr = " " And ThePrevStr = " " Then TheStr = ""
If TheStr <> "" Then ThePrevStr = TheStr
NewName = NewName & TheStr
Next
NoSpaces = NewName
End Function
======================================================
Function NoSpaces1(InName As String) As String
Dim NewName As String, NeXStr As String
Dim I As Integer
NewName = ""
InName = Trim(InName)
For I = 1 To Len(InName) - 1
If Mid(InName, I, 1) = " " And Mid(InName, I + 1, 1) = " " Then NewName = NewName Else NewName = NewName & Mid(InName, I, 1)
NeXStr = Mid(InName, I + 1, 1)
Next
NoSpaces1 = NewName + NeXStr
End Function
================================================
إرسال تعليق