Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Roxxy22 pe Simpatie
 | Femeie
25 ani
Cluj
cauta Barbat
25 - 48 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 787
|
|
Sub Replace_Parag_Chars_In_Table_Cell()
Dim cell As cell
Dim para As Paragraph
Dim text As String
Dim i As Long
' Ensure a selection is made and it is in a table cell
If Selection.Information(wdWithInTable) Then
Set cell = Selection.Cells(1)
text = cell.Range.text
' Remove the end of cell marker
text = Left(text, Len(text) - 2)
' Iterate over the text from end to start to replace paragraph marks
For i = Len(text) To 1 Step -1
If Mid(text, i, 1) = vbCr Then
If i = 1 Or Mid(text, i - 1, 1) <> "." Then
' Check if the next character is not a space before adding a space
If i = Len(text) Or Mid(text, i + 1, 1) <> " " Then
text = Left(text, i - 1) & " " & Mid(text, i + 1)
Else
' If the next character is a space, just remove the paragraph character
text = Left(text, i - 1) & Mid(text, i + 1)
End If
End If
End If
Next i
' Clean up extra spaces
cleanedText = RemoveExtraSpaces(text)
' Update the cell with the cleaned text
cell.Range.text = cleanedText
Else
MsgBox "Please click in a cell in a table.", vbExclamation
End If
End Sub
Function RemoveExtraSpaces(ByVal txt As String) As String
Dim i As Long
Dim temp As String
' Initialize temp string
temp = ""
' Loop through each character in the string
For i = 1 To Len(txt)
' Check if the current character is a space
If Mid(txt, i, 1) <> " " Then
' If the current character is not a space, add it to temp
temp = temp & Mid(txt, i, 1)
ElseIf i > 1 And Mid(txt, i - 1, 1) <> " " Then
' If the current character is a space and the previous character is not a space, add it to temp
temp = temp & Mid(txt, i, 1)
End If
Next i
' Assign the cleaned text to the output variable
RemoveExtraSpaces = temp
End Function
|
Source: ChatGPT
|
|
| pus acum 7 luni |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 787
|
|
If not in table cell, then adapted code for Selection (Function remained the same):
Sub Replace_Parag_Chars_In_Table_Cell()
Dim cell As cell
Dim para As Paragraph
Dim text As String
Dim i As Long
' Ensure a selection is made and it is in a table cell
If Selection.Information(wdWithInTable) Then
Set cell = Selection.Cells(1)
text = cell.Range.text
' Remove the end of cell marker
text = Left(text, Len(text) - 2)
' Iterate over the text from end to start to replace paragraph marks
For i = Len(text) To 1 Step -1
If Mid(text, i, 1) = vbCr Then
If i = 1 Or Mid(text, i - 1, 1) <> "." Then
' Check if the next character is not a space before adding a space
If i = Len(text) Or Mid(text, i + 1, 1) <> " " Then
text = Left(text, i - 1) & " " & Mid(text, i + 1)
Else
' If the next character is a space, just remove the paragraph character
text = Left(text, i - 1) & Mid(text, i + 1)
End If
End If
End If
Next i
' Clean up extra spaces
cleanedText = RemoveExtraSpaces(text)
' Update the cell with the cleaned text
cell.Range.text = cleanedText
Else
text = Selection.Range.text
' Remove the end of cell marker
text = Left(text, Len(text) - 2)
' Iterate over the text from end to start to replace paragraph marks
For i = Len(text) To 1 Step -1
If Mid(text, i, 1) = vbCr Then
If i = 1 Or Mid(text, i - 1, 1) <> "." Then
' Check if the next character is not a space before adding a space
If i = Len(text) Or Mid(text, i + 1, 1) <> " " Then
text = Left(text, i - 1) & " " & Mid(text, i + 1)
Else
' If the next character is a space, just remove the paragraph character
text = Left(text, i - 1) & Mid(text, i + 1)
End If
End If
End If
Next i
' Clean up extra spaces
cleanedText = RemoveExtraSpaces(text)
' Update the cell with the cleaned text
Selection.Range.text = cleanedText
End If
End Sub
|
|
|
| pus acum 7 luni |
|