اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

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

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

  •   انشاء فاتورة على الورد كما موضح فى المرافق 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

     

          

1.png

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information