سلام
این فایل تبدیل کننده زرنگار هست ((دریافت فایل))که فایل های زرنگار جدید رو هم پشتیبانی میکنه!
فقط فایلهای جدید بعد از تبدیل کثیف هستند و کلی تگ اضافه دارند و همچنین اعداد مقلوب شده هستند که برای رفع این مشکل هم یک ماکرو نوشتم ((دریافت ماکرو)) که همراه فایل هستش و با اجرای اون روی فایل تمام تگ های اضافه فایل تبدیل شده زرنگار حذف میشه و اعداد دوباره مقلوب میشن و به حالت اولشون برمیگردند.
امیدوارم لذت ببرید.
کد:
Function Inverter(nb As String) As String Dim bn As String
For i = 1 To Len(nb)
bn = Mid(nb, i, 1) & bn
Next i
Inverter = bn
End Function
Sub invert()
Dim a As Long
Selection.GoTo What = wdGoToLine, Which = wdGoToFirst
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([!0-9])([0-9]@)([!0-9])"
'.Replacement.Text = "\1" & a="\2" inverter(a) & "\3"
.Forward = True
'.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
'.Execute Replace:=wdReplaceOne
While .Execute
Selection.Text = Inverter(Selection.Text)
Wend
End With
Selection.GoTo What = wdGoToLine, Which = wdGoToFirst
End Sub
Sub ZarCleaner()
With Selection.Find
.Text = "\<Page*[0-9]@*\>": .Replacement.Text = "^m": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "[\>-\<]\/F\<\>F*St\=’[A-Z]’[\>-\<]": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "[\>-\<]F*St\=’[A-Z]’[\>-\<]": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "([\>-\<]Image \= )(*)( [\>-\<])": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "<k[ ]?*[ ][0-9]>": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "([\>-\<]align*['left'-'right'-'Center'][\>-\<])(*)([\>-\<]\/align[\>-\<])": .Replacement.Text = "\2": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "[\>-\<]align*['left'-'right'-'Center'][\>-\<]": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = "[\>-\<]\/align[\>-\<]": .Replacement.Text = " ": .Forward = True: .Wrap = wdFindContinue: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = True: .MatchSoundsLike = False: .MatchAllWordForms = False: .Execute Replace:=wdReplaceAll
End With
Call invert
End Sub
خوشحالم به دردت خورد 
