בקשת מידע | מאקרו לתיקוני טקסט

[אפי זינגר]

יש מקרו מוכן להמרת שדה לטקסט?
וכן עוד מקרואים שמתקנים טקסט

תודה

[106]

@אפי-זינגר כתב בבקשת מידע | מאקרו לתיקוני טקסט:

יש מקרו מוכן להמרת שדה לטקסט?

Ctrl + Shift + F11

[אפי זינגר]

@106
לא, לטקסט רגיל
שלא יהיה שדה בכלל.

[106]

@אפי-זינגר תנסה
Ctrl + 6
כמובן לבחור את השדה לפני כן

[975]

@אפי-זינגר

Sub ConvertFieldsToText()
    ActiveDocument.Fields.Unlink
End Sub

נראה לי שזה ככה ותקף לכל המסמך
תבדוק קודם

Spoiler

וכדאי לשאול את המומחים

[pcinfogmach]

https://www.gmayor.com/export_field.htm

[975]

@pcinfogmach
אני לא שואל למה מה שהבאתי לא מספיק
אבל מביא לתועלת החסומים
FieldTextConverter.zip

Spoiler

בשיטה שונה מהתוסף

Sub FieldCodeToString()
Dim oRng as Range
Dim Fieldstring as String
Dim NewString as String
Dim CurrChar as String
Dim CurrSetting as Boolean
Dim fcDisplay as Object
Dim MyData as DataObject
Dim X as Long
NewString = ""
Set fcDisplay = ActiveWindow.View
Application.ScreenUpdating = False
CurrSetting = fcDisplay.ShowFieldCodes
If CurrSetting <> True Then fcDisplay.ShowFieldCodes = True
Set oRng = Selection.Range
Fieldstring = oRng.Text
For X = 1 To Len(Fieldstring)
CurrChar = Mid(Fieldstring, X, 1)
Select Case CurrChar
Case Chr(19)
CurrChar = "{"
Case Chr(21)
CurrChar = "}"
Case Else
End Select
NewString = NewString + CurrChar
Next X
oRng.Text = NewString
Set MyData = New DataObject
MyData.SetText NewString
MyData.PutInClipboard
fcDisplay.ShowFieldCodes = CurrSetting
End Sub

ותהליך הפוך

Sub FieldStringToCode()
' מבוסס על מאקרו שסופק על ידי פול אדשטיין
' ממיר קודי שדה "טקסטואליים" לקודי שדה אמיתיים
' כדי לבצע את ההמרה, פשוט הדבק את קודי השדה "טקסטואליים"
' במסמך שלך, בחר אותם והפעל את המאקרו.
Dim RngFld As Range
Dim RngTmp As Range
Dim oFld As Field
Dim StrTmp As String
Dim sUpdate As String
Dim bFldCodes As Boolean
Const Msg1 = "בחר את הטקסט להמרה ונסה שוב."
Const Msg2 = "אין מחרוזות שדה בטווח שנבחר."
Const Msg3 = "זוגות של סוגריים מרוטים שדות לא תואמים בטווח שנבחר."
Const Title1 = "שגיאה!"
Const Title2 = "לעדכן שדות?"
Application.ScreenUpdating = False
bFldCodes = ActiveDocument.ActiveWindow.View.ShowFieldCodes
If Selection.Type <> wdSelectionNormal Then
MsgBox Msg1, vbExclamation + vbOKOnly, Title1
Exit Sub
End If
If InStr(1, Selection.Text, "{") = 0 Or InStr(1, Selection.Text, "}") = 0 Then
MsgBox Msg2, vbCritical + vbOKOnly, Title1
End If
If Len(Replace(Selection.Text, "{", vbNullString)) <> Len(Replace(Selection.Text, "}", vbNullString)) Then
MsgBox Msg3, vbCritical + vbOKOnly, Title1
Exit Sub
End If
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Set RngFld = Selection.Range
With RngFld
.End = .End + 1
Do While InStr(1, .Text, "{") > 0
הגדר RngTmp = ActiveDocument.Range(Start:=.Start + InStr(.Text, "{") - 1, End:=.Start + InStr(.Text, "}"))
עם RngTmp
בצע את הפעולה בעוד ש-Len(Replace(.Text, "{", vbNullString)) <> Len(Replace(.Text, "}", vbNullString))
.End = .End + 1
If .Characters.Last.Text <> "}" Then .MoveEndUntil cset:="}", Count:=Len(ActiveDocument.Range(.End, RngFld.End))
לולאה
.Characters.First = vbNullString
.Characters.Last = vbNullString
StrTmp = .Text
הגדר oFld = ActiveDocument.Fields.Add(Range:=RngTmp, Type:=wdFieldEmpty, Text:="", PreserveFormatting:=False)
oFld.Code.Text = StrTmp
End With
Loop
ActiveDocument.ActiveWindow.View.ShowFieldCodes = bFldCodes.End
= .End - 1
אם bFldCodes = False אז .Fields.ToggleShowCodes
.בחר
End With
Application.ScreenUpdating = True
sUpdate = MsgBox("האם ברצונך לעדכן את השדות?" & vbCr + vbCr & _
שים לב שאם השדות שהומרו כוללים שדות ASK או FILLIN, " & _
"עדכון יכפה את בקשת הקלט לשדות אלה", vbYesNo, Title2)
If sUpdate = vbYes Then RngFld.Fields.Update
Set RngTmp = Nothing
Set RngFld = Nothing
Set oFld = Nothing
End Sub