سلام
يه مشكلي با كپي اعداد از word به excel دارم و اونم اين كه وقتي اعداد رو كپي پيست مي كنم ديگه ارزش عددي ندارن و صرفا كاراكتر هستن انگار. آيا راهي هست كه ارزش مقادير رو بهشون برگردونه؟
ممنون پيشاپيش
اگه مشکل مربوط به فارسی یا عربی بودن ارقام باشه، باید به رقم های لاتین استاندارد تبدیل شون کنید.
دلیلش اینه که اون اعداد عربی یا فارسی حقیقتا کاراکتر های Unicode عربی هستند، یعنی ٠١٢٣٤٥٦٧٨٩ یا
کاراکتر های فارسی ۰۱۲۳۴۵۶۷۸۹ که کلا ربطی به کاراکتر های 0123456789 ندارند.
Microsoft Office این کاراکتر ها رو به عنوان عدد تفسیر نمی کنه و در نتیجه مقدار عددی متناظر شان را
ثبت نمی کند. راه حل اینه که ابتدا این 10 کاراکتر رقم عربی و 10 رقم فارسی رو دونه دونه به رقم انگلیسی تبدیل کنیم.
یکبار Find & Replace برای تبدیل تمامی ٠ ها به 0 ، یکبار هم برای تبدیل تمامی ١ ها به 1 و ... الی 9
یعنی جمعا باید 10 بار Find & Replace کرد. کار مسخره ای یه. خوشبختانه به کمک یک ماکرو اینکار خیلی ساده میشه.
برای اجرا کردن این ماکرو در منوی Microsoft Word روی دکمه دایره ای سمت چپ بالا کلیک کرده و Word Options
را انتخاب کنید. حالا در بخش Popular تیک گزینه Show Developer tab in the Ribbon رو بزنید و OK کنید.
حالا همواره در منوی بالای Microsoft Word بخش Developer مشاهده می شود. آن بخش را انتخاب کنید.
روی آیکون Macros کلیک کنید. به عنوان نام ماکرو عبارتی مثل Macro1 رو بنویسید و روی دکمه Create کلیک کنید.
حالا کد زیر را کپی کرده و در کد ماکرو جایگزین کنید. اکنون مجددا در Microsoft Word منوی Macro انتخاب کرده و
روی Macro1 کلیک کنید و با دکمه Run اجرایش کنید. بعد از اجرا کردنش تمامی ارقام در متنی که باز کرده اید به انگلیسی تبدیل شده اند و آماده اند تا کپی شان کنید :
کد:
Sub Macro1()
Dim i As Long, j As Long
For j = 0 To 1
For i = 0 To 9
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(1632 + i + j * 144)
.Replacement.Text = ChrW(48 + i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i
Next j
End Sub