النسخ من الوورد الى الاكسيل

[صلاح الصغير]

السلام عليكم و رحمة الله و بركاته

الاساتذة الافاضل 

كثيرا ما نعانى من طلب بيانات معينة من احدى الجهات لعمل قاعدة بيانات اكسيل او اكسيس مثلا 

و يتم ارسال البيانات على ملف وورد و حينها تظهر المعاناة فى النسخ و التنسيق خصوصا التاريخ و الارقام

لقد تم طلب مثل هذا الطلب بواسطة الاخ بكرى

و الاستاذ / ياسر بارك الله فيه

طلب اضافة موضوع جديد

فهذا هو الملف

على فكرة اسهل كتير من ملف الاستاذ بكرى

test.rar

[ياسر خليل أبو البراء]

جرب الملف التالي أخي الفاضل صلاح

 

Salah.rar

[ياسر خليل أبو البراء]

أو جرب الكود التالي

Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Integer
    Dim iRow As Long
    Dim iCol As Integer
    Dim ResultRow As Long
    Dim TableStart As Integer
    Dim TableTot As Integer
    
    On Error Resume Next
    
    ActiveSheet.Range("A:AZ").ClearContents
    
    wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , "Browse for file containing table to be imported")
    
    If wdFileName = False Then Exit Sub
    
    Set wdDoc = GetObject(wdFileName)
    
    With wdDoc
        TableNo = wdDoc.tables.Count
        TableTot = wdDoc.tables.Count
        If TableNo = 0 Then
            MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
        ElseIf TableNo > 1 Then
            TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & "Enter the table to start from", "Import Word Table", "1")
        End If
    
        ResultRow = 4
    
        For TableStart = 1 To TableTot
            With .tables(TableStart)
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(ResultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                    Next iCol
                    ResultRow = ResultRow + 1
                Next iRow
            End With
            ResultRow = ResultRow + 1
        Next TableStart
    End With
End Sub

تقبل تحياتي

[صلاح الصغير]

ا / ياسر

لحد كده جميل اوى حضرتك وفرت علينا عملية النسخ و اللصق 

و يبقى شى واحد مهم تنسيق التاريخ

Salah.rar

[ياسر خليل أبو البراء]

ماله تنسيق التاريخ

كليك يمين وبعدين Format cells واختر Date ونسق التاريخ كما يحلو لك

[صلاح الصغير]

لا يقوم بعملية التنسيق

[ياسر خليل أبو البراء]

هل جربت المشاركة رقم 2 ورقم 3 ؟

جرب الاتنين وشوف

لأني نسقت التاريخ وشغال عادي

[علاء رسلان]

السلام عليكم

بالفعل استاذ ياسر هناك مشكلة فى تنسيق التواريخ أخى الحبيب أعتقد انها تكمن فى ادخال التاريخ نفسه من البداية خطأ .. التاريخ لا يقبل التنسيق لأنه لا يعامل على هذا الاساس فى اكسيل و اعتقد انه يعتبره نص او شئ من هذا القبيل .

 

[علاء رسلان]

الأخ صلاح لحل هذه المشكلة اقترح عليك

عمل عمودين للتواريخ و أخذ قيم الخلايا من أعمدة التواريخ ( التى لا تعمل مع التنسيق ) بالدالة

Value

ثم نسخ القيم الناتجة و لصقها كقيمة بأماكنها و شغل التنسيق للتاريخ و سيعمل معك دون مشاكل

مرفق ملف استرشادى .. الصفحة 1 به المعادلة و الصفحة 2 بعد اتمام الاجراء

 

 

Salah.rar