Postada em 22/10/2013 11:38 hs
Amigo, tem sim...
Primeiro coloque as seguintes funções em um módulo .BAS
'--------------------------------------------------------------------------------------------------------------------------------------------------------
'Atribuir valor a determinado piece !
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function SetaPiece(ByVal StringDePieces As String, _
ByVal Separador As String, _
ByVal PosicaoPiece As Integer, _
ByVal NovoConteudoDoPiece As String) _
As String
On Error Resume Next
Dim strPieces As String
Dim SepPieces As String
Dim PosPiece As Integer
Dim ConteudoDoPiece As String
Dim StringDePiecesRetornar As String
Dim intQtdPieces As Integer
Dim CForNext As Double
strPieces = StringDePieces
SepPieces = Separador
PosPiece = PosicaoPiece
ConteudoDoPiece = NovoConteudoDoPiece
'Saber a quantidade de pieces
intQtdPieces = QuantidadeDePieces(strPieces, SepPieces)
'Se não há posição de piece a ser setada, então é o piece 1 mesmo, ou seja, considera-se que existe apenas um piece
If intQtdPieces <= 1 Then
StringDePiecesRetornar = ConteudoDoPiece
GoTo SAIRDAFUNCAO
End If
'Fazer um contador e, atingindo o piece a ser trocado, colocar o novo conteúdo do piece
StringDePiecesRetornar = ""
For CForNext = 1 To intQtdPieces
If CForNext = PosPiece Then
StringDePiecesRetornar = StringDePiecesRetornar & ConteudoDoPiece & SepPieces
Else
StringDePiecesRetornar = StringDePiecesRetornar & Piece(strPieces, SepPieces, CForNext) & SepPieces
End If
Next CForNext
If Right(StringDePiecesRetornar, 1) = SepPieces Then
StringDePiecesRetornar = Left(StringDePiecesRetornar, Len(StringDePiecesRetornar) - 1)
End If
'Sair da função
SAIRDAFUNCAO:
SetaPiece = StringDePiecesRetornar
End Function
'--------------------------------------------------------------------------------------------------------------------------------------------------------
'Buscar conteúdo de determinado piece !
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function Piece(ByVal Conteudo As String, _
ByVal Separador As String, _
ByVal PosicaoPiece As Integer) _
As String
Dim ExtraPiece As String
Dim Cont1Piece As Integer
Dim Cont2Piece As Integer
Dim bkpPosicaoPiece As Integer
Dim SepPieces As String
bkpPosicaoPiece = PosicaoPiece - 1
SepPieces = Separador
ExtraPiece = ""
Cont2Piece = 0
For Cont1Piece = 1 To Len(Conteudo)
If Mid(Conteudo, Cont1Piece, 1) = SepPieces Then Cont2Piece = Cont2Piece + 1
If Cont2Piece = bkpPosicaoPiece Then Exit For
Next Cont1Piece
If Cont2Piece < bkpPosicaoPiece Then
Piece = ExtraPiece
Exit Function
End If
ExtraPiece = Mid(Conteudo, Cont1Piece)
If Left(ExtraPiece, 1) = SepPieces Then ExtraPiece = Mid(ExtraPiece, 2)
Cont2Piece = InStr(1, ExtraPiece, SepPieces)
If Cont2Piece > 0 Then ExtraPiece = Mid(ExtraPiece, 1, Cont2Piece - 1)
Piece = ExtraPiece
End Function
'--------------------------------------------------------------------------------------------------------------------------------------------------------
'Saber a quantidade de pieces em uma string !
'--------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function QuantidadeDePieces(ByVal Texto As String, _
ByVal Separador As String) _
As Integer
On Error Resume Next
Dim Tamanho As Double
Dim Contador As Double
Dim QtdPieces As Integer
Dim SepPieces As String
Tamanho = Len(Texto)
SepPieces = Separador
If Texto = "" Then
QtdPieces = 0
GoTo SAIRDAFUNCAO
End If
'Inicialmente, mesmo que não exista separador de pieces, ainda assim já existe o piece 1, porque o separador de pieces apenas separaria do segundo piece
QtdPieces = 1
For Contador = 1 To Tamanho
If Mid(Texto, Contador, 1) = SepPieces Then QtdPieces = QtdPieces + 1
Next Contador
SAIRDAFUNCAO:
QuantidadeDePieces = QtdPieces
End Function
Depois use o seguinte código:
Dim strVariavel As String
Dim x As Integer
strVariavel = "XXXX YYYY CCCC"
Text1.Text = ""
strVariavel = Replace(strVariavel, " ", ",")
Select Case QuantidadeDePieces(strVariavel, ",") - 1
Case 0
Text1.Text = strVariavel
Case Else
For x = 1 To QuantidadeDePieces(strVariavel, ",") - 1
Text1.Text = Text1.Text & Piece(strVariavel, ",", x) & " ,"
Next x
Text1.Text = Left(Text1.Text, Len(Text1.Text) - 2)
End Select
If QuantidadeDePieces(strVariavel, ",") > 1 Then
Text1.Text = Text1.Text & " e " & Piece(strVariavel, ",", QuantidadeDePieces(strVariavel, ","))
End If
Funcionará com qualquer quantidade de pedaços, bastando que esteja separados por espaço em branco.
Exemplos:
XXXX -> Text1.Text ficará com XXXX
XXXX YY -> Text1.Text ficará com XXXX, YY
XXXX YYY CCCCC Text1.Text ficará com XXXX, YYY e CCCCC
Tudo de bom.
Euzébio Cruz
Criciúma - SC
|
