تعديل على كود

[أبو محمد أشرف]

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

هذا الكود يقوم بالترحيل من الاكسيل إلى الوورد ولكن المشكلة كلما زدت المدى لا يتم ترحيل شيء  فما المشكلة التي في هذا السطر

 wdDoc.ActiveWindow.Selection.Tables(1).PreferredWidth = CentimetersToPoints(13)

    'Name of the existing Word doc.
    Const stWordReport As String = "Quarter Report.docx"
    
    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdbmRange As Word.Range
    
    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnReport As Range
    
    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")
    Set rnReport = wsSheet.Range("A1:D53954")
    
    'Initialize the Word objets.
    Set wdApp = New Word.Application
     rnReport.Copy
    Set wdDoc = wdApp.Documents.Add(Template:="Normal", NewTemplate:=False, DocumentType:=0)
    
    
    wdApp.Visible = True
    wdDoc.Activate
    
    rnReport.Copy
   
    wdDoc.ActiveWindow.Selection.PasteExcelTable False, False, False
    wdDoc.ActiveWindow.Selection.Tables(1).Rows(2).HeadingFormat = True '. .Select
  wdDoc.ActiveWindow.Selection.Tables(1).PreferredWidth = CentimetersToPoints(13)
    With wdDoc.ActiveWindow.Selection.PageSetup
        .TopMargin = CentimetersToPoints(2)
        .BottomMargin = CentimetersToPoints(2)
        .LeftMargin = CentimetersToPoints(1.5)
        .RightMargin = CentimetersToPoints(1.5)
        .Gutter = CentimetersToPoints(0)
    End With
    
    Set wdbmRange = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    'Clear out the clipboard, and turn screen updating back on.
    With wbBook.Application
       .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
    MsgBox "Done"

End Sub

 

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

جرب تغير عرض الأعمدة الموجودة في ملف الإكسيل إلى عرض أقل ...

[أبو محمد أشرف]

جزاك الله خيرا جاري التفيذ