جدا کردن کلمات انگلیسی از متن فارسی در نرم افزار word

**M_ExceL** · 2020/12/13, 23:50

سلام،
نمونه ای از متنتون را در قالب فایل ورد پیوست کنید
تا مورد بررسی قرار گیرد

**bnyamin** · 2020/12/14, 09:31

نوشته اصلی توسط M_ExceL

سلام،
نمونه ای از متنتون را در قالب فایل ورد پیوست کنید
تا مورد بررسی قرار گیرد

با تشکر
همان گونه که مشخص است ؛متن دارای کلمات انگلیسی است
میخواهیم بعد از این کلمات انگلیسی ؛ ادامه متن در خط جدید قرار بگیرد

فایل های پیوست شده

شناخت.docx (15.4 کیلو بایت, مشاهدات 3)

**bnyamin** · 2020/12/15, 11:06

نوشته اصلی توسط M_ExceL

سلام،
نمونه ای از متنتون را در قالب فایل ورد پیوست کنید
تا مورد بررسی قرار گیرد

ابته ما باید این سنخ فایلها رو متاثر از فایل ووورد در یک نرم افزار دیگر ایمپورت کنیم (x mind) و چون اون نرم افزار دیگر نمیتواند بین زبان فارسی و انگلیسی تفاوت بگذارد متن رو بهم ریخته میکند
و بدیهی است که فایلی که قرار داده ام یک نمونه کوچک است و فایلهای اصلی مثلا چندین صفحه است که در بین آنها کلمات انگلیسی وجود دارد .

**M_ExceL** · 2020/12/15, 14:10

نوشته اصلی توسط bnyamin

ابته ما باید این سنخ فایلها رو متاثر از فایل ووورد در یک نرم افزار دیگر ایمپورت کنیم (x mind) و چون اون نرم افزار دیگر نمیتواند بین زبان فارسی و انگلیسی تفاوت بگذارد متن رو بهم ریخته میکند
و بدیهی است که فایلی که قرار داده ام یک نمونه کوچک است و فایلهای اصلی مثلا چندین صفحه است که در بین آنها کلمات انگلیسی وجود دارد .

سلام،
کد زیر رو تست کنید :

کد:

Sub M_ExceL()

        Dim icounter As Long
        Dim doc As Document
        Set doc = ActiveDocument
        
        icounter = 1
        
        While icounter <> doc.Range.Characters.Count
        
                If Asc(doc.Range.Characters(icounter)) > 96 _
                And Asc(doc.Range.Characters(icounter)) < 123 Then
                    Do Until Asc(doc.Range.Characters(icounter)) = 32 _
                    Or Asc(doc.Range.Characters(icounter)) = 41
                        icounter = icounter + 1
                    Loop
               doc.Range.Characters(icounter + 1) = vbNewLine
               End If
               
        icounter = icounter + 1
        
        Wend

End Sub

**bnyamin** · 2020/12/15, 15:22

نوشته اصلی توسط M_ExceL

سلام،
کد زیر رو تست کنید :

کد:

Sub M_ExceL()

        Dim icounter As Long
        Dim doc As Document
        Set doc = ActiveDocument
        
        icounter = 1
        
        While icounter <> doc.Range.Characters.Count
        
                If Asc(doc.Range.Characters(icounter)) > 96 _
                And Asc(doc.Range.Characters(icounter)) < 123 Then
                    Do Until Asc(doc.Range.Characters(icounter)) = 32 _
                    Or Asc(doc.Range.Characters(icounter)) = 41
                        icounter = icounter + 1
                    Loop
               doc.Range.Characters(icounter + 1) = vbNewLine
               End If
               
        icounter = icounter + 1
        
        Wend

End Sub

با تشکر
متاسفانه پاسخ گو نیست .
البته برخی از اوقات هم فقط یک کلمه انگلیسی نیست وبلکه شاید دو کلمه و یا حتی جمله باشد .
بنده فایل اصلی خود را خدمتتون قرار میدهم
فایل فوق در محیط اوتلاین سطح بندی شده است

فایل های پیوست شده

معرفت_شناسی یا شناخت_شناسی 3.docx (54.4 کیلو بایت, مشاهدات 6)

**M_ExceL** · 2020/12/15, 19:10

نوشته اصلی توسط bnyamin

با تشکر
متاسفانه پاسخ گو نیست .
البته برخی از اوقات هم فقط یک کلمه انگلیسی نیست وبلکه شاید دو کلمه و یا حتی جمله باشد .
بنده فایل اصلی خود را خدمتتون قرار میدهم
فایل فوق در محیط اوتلاین سطح بندی شده است

سلام،
این یکی رو تست بفرمایید :
توضیح :
به دلیل این که کد کلمه به کلمه تمام متن را بررسی می کند مقداری زمان می برد
بعد از اجرای کد محیط vba را مینیمایز نمایید سپس شاهد بررسی خط به خط متن خواهید بود

کد:

Sub M_ExceL()

    Dim i As Long
    Dim b As Boolean
    
    i = 1
    While i <> ActiveDocument.Range.Words.Count
        ActiveDocument.Range.Words(i).Select
        If Asc(LCase(ActiveDocument.Range.Words(i).Characters(1))) > 96 And Asc(LCase(ActiveDocument.Range.Words(i).Characters(1))) < 123 Then
            b = False
            Do While b = False
                If Asc(LCase(ActiveDocument.Range.Words(i).Characters(1))) > 96 And Asc(LCase(ActiveDocument.Range.Words(i).Characters(1))) < 123 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) > 47 And Asc(ActiveDocument.Range.Words(i).Characters(1)) < 58 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 32 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 40 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 41 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 44 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 46 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 47 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 58 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 60 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 39 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 34 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 147 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 148 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 59 Then
                b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 96 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 45 Then
                    b = False
                ElseIf Asc(ActiveDocument.Range.Words(i).Characters(1)) = 150 Then
                b = False
                Else
                    b = True
                End If
                i = i + 1
            Loop
            ActiveDocument.Range.Words(i - 1).InsertBefore (vbNewLine)
        End If
        DoEvents
        i = i + 1
    Wend

End Sub