طباعة فاتورة من الاكسس الى الورد

[jamal2080]

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

    اريد عرض الفاتورة من الاكسس الى الورد 

•   انشاء فاتورة على الورد كما موضح فى المرافق 1
•  اعداد اشارة مراجعية لكل الحقل
• يعرض البيانات راس الفاتورة 
• مشكلة فى جدول الفاتورة لا يعرض بيانات 
• وهذا الكود لعرض الفاتورة على الورد

  Private Sub cmdprv_Click()
      On Error Resume Next ' استمرار التنفيذ عند حدوث خطأ
      Dim X As Object
      Set X = CreateObject("Word.Application")
      X.Documents.Open CurrentProject.Path & "\Reporet_RD.docx"
      X.Visible = True
  
      ' تعبئة العلامات المرجعية في المستند بالقيم المعطاة
      FillBookmark X, "RD", RD
      FillBookmark X, "cost_center_and", cost_center_and
      FillBookmark X, "Supply_No", Supply_No
      FillBookmark X, "Received_date", Received_date
      FillBookmark X, "MANDUB_IF", MANDUB_IF
      FillBookmark X, "MANcheckup_IF", MANcheckup_IF
      FillBookmark X, "q_1", q_1
      FillBookmark X, "Total_RD", Total_RD
  
      ' تعبئة العلامات المرجعية للنموذج الفرعي
      FillBookmark X, "Automatic_No", Automatic_No
      FillBookmark X, "dscrp", dscrp
      FillBookmark X, "uoi", uoi
      FillBookmark X, "qty", qty
      FillBookmark X, "qty_T", qty_T
      FillBookmark X, "unit_price", unit_price
      FillBookmark X, "tot_price", tot_price
  
      ' إضافة جدول الفاتورة مع تنسيق جميل
      AddInvoiceTable X
  
  End Sub
  
  ' دالة فرعية لتعبئة العلامة المرجعية في المستند
  Private Sub FillBookmark(ByRef doc As Object, ByVal bookmarkName As String, ByVal value As Variant)
      On Error Resume Next ' استمرار التنفيذ عند حدوث خطأ
      With doc.ActiveDocument
          If .Bookmarks.Exists(bookmarkName) Then
              .Bookmarks(bookmarkName).Range.Text = value
          Else
              MsgBox "العلامة المرجعية " & bookmarkName & " غير موجودة في المستند.", vbExclamation
          End If
      End With
  End Sub
  
  ' دالة فرعية لإضافة جدول الفاتورة مع تنسيق
  Private Sub AddInvoiceTable(ByRef doc As Object)
      Dim tbl As Object
      Dim rng As Object
      Dim rowIndex As Integer
      
      ' تحديد المكان لإدراج الجدول (يمكنك تعديل العلامة المرجعية أدناه)
      Set rng = doc.ActiveDocument.Bookmarks("InvoiceTable").Range
      
      ' إنشاء الجدول: 8 أعمدة وعدد الصفوف بناءً على البيانات
      Set tbl = doc.ActiveDocument.Tables.Add(rng, 2, 7)
      tbl.Borders.Enable = True
      
      ' تعيين رؤوس الأعمدة
      tbl.Cell(1, 1).Range.Text = "رقم الطلب"
      tbl.Cell(1, 2).Range.Text = "الوصف"
      tbl.Cell(1, 3).Range.Text = "الوحدة"
      tbl.Cell(1, 4).Range.Text = "الكمية"
      tbl.Cell(1, 5).Range.Text = "الكمية الإجمالية"
      tbl.Cell(1, 6).Range.Text = "سعر الوحدة"
      tbl.Cell(1, 7).Range.Text = "السعر الكلي"
      
      ' تطبيق التنسيق على رؤوس الأعمدة
      For i = 1 To 7
          With tbl.Cell(1, i).Range
              .Font.Bold = True
              .ParagraphFormat.Alignment = wdAlignParagraphCenter
              .Font.Size = 12
          End With
      Next i
      
      ' إضافة بيانات الصف الأول
      rowIndex = 2
      tbl.Cell(rowIndex, 1).Range.Text = Automatic_No
      tbl.Cell(rowIndex, 2).Range.Text = dscrp
      tbl.Cell(rowIndex, 3).Range.Text = uoi
      tbl.Cell(rowIndex, 4).Range.Text = qty
      tbl.Cell(rowIndex, 5).Range.Text = qty_T
      tbl.Cell(rowIndex, 6).Range.Text = unit_price
      tbl.Cell(rowIndex, 7).Range.Text = tot_price
  
      ' تطبيق تنسيق على البيانات
      For i = 1 To 7
          With tbl.Cell(rowIndex, i).Range
              .Font.Size = 10
              .ParagraphFormat.Alignment = wdAlignParagraphCenter
          End With
      Next i
      
      ' تطبيق تنسيق الجدول
      With tbl
          .Rows(1).Shading.BackgroundPatternColor = RGB(217, 217, 217)
          .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
          .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
          .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
          .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
          .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
          .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
          .Range.ParagraphFormat.SpaceAfter = 6
      End With
  
      ' تعيين عرض الأعمدة
      tbl.Columns(1).Width = CentimetersToPoints(2.5)
      tbl.Columns(2).Width = CentimetersToPoints(4.5)
      tbl.Columns(3).Width = CentimetersToPoints(2.5)
      tbl.Columns(4).Width = CentimetersToPoints(2.5)
      tbl.Columns(5).Width = CentimetersToPoints(3)
      tbl.Columns(6).Width = CentimetersToPoints(3)
      tbl.Columns(7).Width = CentimetersToPoints(3.5)
  End Sub
  
  ' دالة لتحويل السنتيمترات إلى نقاط
  Function CentimetersToPoints(cm As Double) As Double
      CentimetersToPoints = cm * 28.35
  End Function