ماكروا لادراج جدول اسفل الجدول الحالي

[ماجدجلال]

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

اخواني الاعزاء , بعد البحث الذي دام اربع ايام دون فائدة طرحت السؤال و ارجو منكم المساعدة , في الملف المرفق كيف اصمم ماكروا يقوم بادراج الجدول الموجود في الملف المرفق 

و فكرة الملف تقوم علي اساس . بعد الانتهاء من الكتابة في الجدول الحالي يقوم الماكروا بادراج الجدول هو نفس الجدول السابق  و وضعه اسفل الجدول الاخير ( ظرور ترك سطر فاصل بعد الجدولين ) 

ارجو المساعدة و لكم جزيل الشكر و الامتنان 

1050.rar

[ماجدجلال]

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

قمت بالبحث قي المواقع الاجنبية ( الترجمة بواسطة جوجل ) لعلني  اجد الحل 

و وجدت الكود التالي  ولكن به اخطاء و لم ينفذ المطلوب منه ,,,

 

Sub aTest()
  Dim srcDoc As Document, tgtDoc As Document
  Dim srcTable As Table, tgtTable As Table
  Dim i As Integer, strTime As String, strDesc As String
  
  Set srcDoc = Documents("Test daily (1).docx")
  Set tgtDoc = Documents("Test www.docx")
  Set srcTable = srcDoc.Tables(1)
  Set tgtTable = tgtDoc.Tables(1)
  
  For i = 2 To srcTable.Rows.Count
    strTime = srcTable.Cell(i, 1).Range.Text
    strTime = Left(strTime, Len(strTime) - 2)
    strDesc = srcTable.Cell(i, 2).Range.Text
    strDesc = Left(strDesc, Len(strDesc) - 2)
    tgtTable.Cell(i, 1).Range.ContentControls(1).Range.Text = strTime
    tgtTable.Cell(i, 5).Range.ContentControls(1).Range.Text = strDesc
  Next
End Sub

 

[محمد طاهر عرفه]

السلام عليكم

الكود السابق لا يتعلق بالمطلوب 

 

 هذا حل قد يكون  قريب مما تريد

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

Sub CopyMyTable()


    Dim doc As Word.Document
    Dim tbl As Word.Table
    Dim rngTableTarget As Word.Range

    Set doc = ActiveDocument
    Set tbl = doc.Tables(1)
    Set rngTableTarget = doc.Content

 
    rngTableTarget.Collapse wdCollapseStart
    rngTableTarget.FormattedText = tbl.Range.FormattedText
Selection.SplitTable

End Sub

و لتشغيله فى الملف المرفق 

قف فى خانة التاريخ اولا فى الجدول الاول ، ثم شغل الماكرو  من القائمة

او عن طريق CTR+o

كشكول.rar

[ماجدجلال]

و عليكم السلام 

ماشاء الله  

ان شاء الله اجرب الكود وان شاء الله يكون هو المطلوب 

شكرا لك استاذ محمد الف شكر