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

جمال جبريل

03 عضو مميز
  • Content Count

    132
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

1 Neutral

عن العضو جمال جبريل

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    مهندس

اخر الزوار

بلوك اخر الزوار معطل ولن يظهر للاعضاء

  1. انا لدي ماكروا يستخرج كل الاشارات المرجعية من مستند الي جدول في اخر الصفحة ، وفيها اسم الاشارة المرجعية ، ورقم الصفحة ، ورقم السطر ، ورقم المقطع ، واريد ان يكون هذا الامر بالعكس، اي من خلال هذا الجدول اريد ان اضيف الاشارات المرجعية من خلال هذا الجدول والمعلومات المضافة اليها ، الماكروا موجود داخل المستند Sub ExtractBookmarksInSameDoc() Dim objBookmark As Bookmark Dim objTable As Table Dim nRow As Integer Dim objDoc As d*ocument, objNewDoc As d*ocument Dim objParagraph As Paragraph Set objDoc = Actived*ocument If objDoc.Bookmarks.Count = 0 Then MsgBox ("There is no bookmark in this d*ocument." Else 'Set objNewDoc = d*ocuments.Add Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'" Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=5) objTable.Borders.Enable = True nRow = 1 For Each objParagraph In objDoc.Paragraphs If objParagraph.Range.Style = "Caption" Then objParagraph.Range.Delete End If Next objParagraph With objTable .Cell(1, 1).Range.Text = "Name" .Cell(1, 2).Range.Text = "Sections" .Cell(1, 3).Range.Text = "Page Number" .Cell(1, 4).Range.Text = "lines" .Cell(1, 5).Range.Text = "Colm" For Each objBookmark In objDoc.Bookmarks objTable.Rows.Add nRow = nRow + 1 .Cell(nRow, 1).Range.Text = objBookmark.Name .Cell(nRow, 2).Range.Text = objBookmark.Range.Information(wdActiveEndSectionNumber) .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber) .Cell(nRow, 4).Range.Text = objBookmark.Range.Information(wdFirstCharacterLineNumber) ' '(wdVerticalPositionRelativeToPage) '(wdFirstCharacterLineNumber) .Cell(nRow, 5).Range.Text = objBookmark.Range.Information(wdVerticalPositionRelativeToPage) '(wdStartOfRangeColumnNumber)'(wdHorizontalPositionRelativeToTextBoundary)'(wdActiveEndAdjustedPageNumber)'(wdActiveEndAdjustedPageNumber) objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _ SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text Next objBookmark End With End If 'objNewDoc.SaveAs2 FileName:=objDoc.Path & "" & "Bookmarks in " & objDoc.Name End Sub سؤال لادراج الاشارات المرجعية برقم الصفحة ورقم السطر.rar
  2. نحن نريد ما بين الاقواس ، يعني النصوص المكتوب فقط بدون الاقواس
  3. الفاصلة تم تعديلها كما قلت اكتبها من يمين الي اليسار ام من اليسار الي اليمين
  4. حاولتي مرارا وتكرارا ان اكتبه بالطريقة الصحيحة وفشلت ، ممكن تكتبه في ملف تكس او وورد او اعمله ماكروا ليستفاد الجميع
  5. جميل جدا ، وبارك الله فيكم ولكن ما فرق بين المصفوفة ، والاسماء المعرفة ، يعني لدي خلايا من a1:b50 معرفة باسم ولو كان هناك فرق ، ما هو الافضل ولماذا؟
  6. رغم انني وضعت سؤالا قبل ذلك ومن يجاوب احدا علينا رغم محترفين ، ولعل المانع خيرا. لسؤال جديد عسى ان يهتم به احدا: وجدت كود في المواقع الاجنبية ينسخ كل الجداول المعرفة في الاكسل الي وورد، في مستند جديد بحيث يكون كل جدول في صفحة ، وهذا هو الكود : Sub CopyWorksheetsToWord() ' requires a reference to the Word Object library:' --- Comment ' in the VBE select Tools, References and check the Microsoft Word X.X object library' --- Comment Dim tbl As ListObject Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet Application.ScreenUpdating = False Application.StatusBar = "Creating new document..." Set wdApp = New Word.Application Set wdDoc = wdApp.Documents.Add For Each ws In ActiveWorkbook.Worksheets Application.StatusBar = "Copying data from " & ws.Name & "..." For Each tbl In ActiveSheet.ListObjects tbl.Range.Copy 'ws.UsedRange.Copy ' or edit to the range you want to copy' --- Comment wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste Application.CutCopyMode = False wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter ' insert page break after all worksheets except the last one' --- Comment If Not ws.Name = Worksheets(Worksheets.Count).Name Then With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range .InsertParagraphBefore .Collapse Direction:=wdCollapseEnd .InsertBreak Type:=wdPageBreak '.InsertBreak Type:=7 End With End If Next tbl Next ws Set ws = Nothing Application.StatusBar = "Cleaning up..." ' apply normal view' --- Comment With wdApp.ActiveWindow If .View.SplitSpecial = wdPaneNone Then .ActivePane.View.Type = wdNormalView Else .View.Type = wdNormalView End If End With Set wdDoc = Nothing wdApp.Visible = True Set wdApp = Nothing Application.StatusBar = False End Sub ووجدت كود اخر ينسخ الاسماء المعرفة في الاكسل الي وورد ولكن يلصقها في اشارات مرجعية ، بحيث يكون كل اسم معرف يطابق اسم الاشارة المرجعية، وهذا الكود: Option Explicit Sub namesToBookmarks() Dim objWord As Object Dim docWord As Object Dim wb As Excel.Workbook Dim xlName As Excel.Name Dim Path As String Set wb = ActiveWorkbook Path = "C:\Users\jjebril\Desktop\MacroTest.docx" ''///change the name On Error GoTo ErrorHandler ''///Create a new Word Session Set objWord = CreateObject("Word.Application") On Error GoTo ErrorHandler ''///Open document in word Set docWord = objWord.Documents.Add(Path) ''///Loop through names in the activeworkbook For Each xlName In wb.Names ''///if xlName''///s name is existing in document then put the value in place of the bookmark If docWord.Bookmarks.Exists(xlName.Name) Then docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value) End If Next xlName ''///Activate word and display document With objWord .Visible = True .ActiveWindow.WindowState = 0 .Activate End With ''///Release the Word object to save memory and exit macro ErrorExit: Set objWord = Nothing Exit Sub ''///Error Handling routine ErrorHandler: If Err Then MsgBox "Error No: " & Err.Number & ": an error occurred" If Not objWord Is Nothing Then objWord.Quit False End If Resume ErrorExit End If End Sub اريد فقط نسخ كل الجداول الموجودة في الاكسل ولصقها في وورد ولكن تبعا للاشارات المرجعية التي لها نفس اسماء الجداول مثل المثال الثاني. يعني المثال اول ننسخ كل الجداول المعرفة الي وورد ولكن تبعا للاشارات المرجعية في وورد والتي بنفس اسماء الجداول المعرفة في اكسل ولكم جزيل الشكر.
  7. وجدت هذا الكود في بعض المواقع الاجنبية وهي تنسخ اي شئ مكتوب في اي ورقة في اكسل الي مستند جديد في وورد Option Explicit Sub CopyWorksheetsToWord() ' requires a reference to the Word Object library:' --- Comment ' in the VBE select Tools, References and check the Microsoft Word X.X object library' --- Comment Dim wdApp As Word.Application, wdDoc As Word.Document, ws As Worksheet Application.ScreenUpdating = False Application.StatusBar = "Creating new document..." Set wdApp = New Word.Application Set wdDoc = wdApp.Documents.Add For Each ws In ActiveWorkbook.Worksheets Application.StatusBar = "Copying data from " & ws.Name & "..." ws.UsedRange.Copy ' or edit to the range you want to copy' --- Comment wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste Application.CutCopyMode = False wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.InsertParagraphAfter ' insert page break after all worksheets except the last one' --- Comment If Not ws.Name = Worksheets(Worksheets.Count).Name Then With wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range .InsertParagraphBefore .Collapse Direction:=wdCollapseEnd .InsertBreak Type:=wdPageBreak End With End If Next ws Set ws = Nothing Application.StatusBar = "Cleaning up..." ' apply normal view' --- Comment With wdApp.ActiveWindow If .View.SplitSpecial = wdPaneNone Then .ActivePane.View.Type = wdNormalView Else .View.Type = wdNormalView End If End With Set wdDoc = Nothing wdApp.Visible = True Set wdApp = Nothing Application.StatusBar = False End Sub اريد فقط ان يتم تعديل الكود لينسخ كل الجداول الموجودة في اكسل الي ملف وورد بدلا من نسخ كل شئ مكتوب في اكسل
  8. طول عمرك مبدع يا ياسر عرابي اريد فقط ان يبحث عن الاسم الاول او الوسط او الاخير ، ولا اتقيد بالاسم الاول فقط ، يعني البحث في الاسم او اسم الاب او الجد او الاسم الاخير دون التقيدم بالاسم الاول فقط
  9. نريدها ما تم عمله من يمين الي اليسار او العكس ، وليس من اعلي الي اسفل او العكس
  10. ما فيش مشاكل ، ممكن نتخلص من كل التنسيقات الموجودة ، لان ممكن يكون تنسيقه اسهل من حذف هذه الانماط
  11. شكرا لك على الاهتمام ، ومقدر جدا ظروفك الشخصية ، يكفي انك تعطي بعضا من وقتك للرد علينا ، وربنا يجزيك خيرا ان شاء الله ، ومتاكد انك سوف تنال هذا الجزاء الحسن ان شاء الله. ولكني جربت هذا الكود على اوفيس 2016 وحدثت مشكلة ايضا ، لانني نقلته الي ملف اخر ، فهل هذه هي المشكلة ، ام انها سوف تعمل مع كل الملفات ومع تغيير او اضافة اوراق اخرى للمصنف ام ان المشكلة انه لا يوجد بعض الاوراق غير محددة فيها ناحية الطباعة
  12. شكرا لك على الاهتمام ، ومقدر جدا ظروفك الشخصية ، يكفي انك تعطي بعضا من وقتك للرد علينا ، وربنا يجزيك خيرا ان شاء الله ، ومتاكد انك سوف تنال هذا الجزاء الحسن ان شاء الله. ولكني جربت هذا الكود على اوفيس 2016 وحدثت مشكلة ، لانني نقلته الي ملف اخر ، فهل هذه هي المشكلة ، ام انها سوف تعمل مع كل الملفات ومع تغيير او اضافة اوراق اخرى للمصنف وممكن تكمل جميلك ، تجعلها مفتوحة ، اي اختار اسم الملف الذي اريد الترحيل اليه ، واختار ايضا المكان الذي احفظه ، خاصة لو كان ملف جديد
  13. حذف كل شئ في ش مصنف ما عدا المحددة للطباعة حذف كل شئ في ش مصنف ما عدا المحددة للطباعة.rar
  14. لدي ملف به عدة شيتات او اوراق ، واريد ترحيلها الي ملف اخر ، بعد مسح كل المعادلات التي بالاوراق ترحيل عدة شيتات او اوراق الي ملف اكسل اخر.rar
×
×
  • اضف...