بحث مخصص من جوجل فى أوفيسنا
Custom Search
  • 0
محمد طاهر

طباعة الملاحظات و علامات المراجعة فى فيزيو 2010

السؤال

يحتوى برنامج الفيزيو 2010  على خاصية اضافة الملاحظات و علامات المراجعة Mark up

و لكن للاسف لا يحوي امكانيات متقدمة مثل برنامج الوورد للتحكم فى طباعتها

 

و لكن يوجد حل بديل عن طريق الماكرو

حيث يتم انشاء مربع نص و نسخ قائمة بالتعديلات اليه و ذلك بجوار الرسم

 

المصدر

http://support.microsoft.com/kb/898514/en-us

 

و هذا هو الكود

Public Sub GetComments()
Dim pagMarkup As Visio.Page
Dim pag As Visio.Page
Dim shp As Visio.Shape
Dim sText As String
Dim iRow As Integer

Set pag = Visio.ActivePage
sText = "Reviewer" & vbTab & "Date" & vbTab & "Comment"

If pag.PageSheet.SectionExists(Visio.visSectionAnnotation, Visio.visExistsAnywhere) Then
For iRow = 0 To pag.PageSheet.RowCount(Visio.visSectionAnnotation) - 1
sText = sText & vbCrLf & pag.Document.DocumentSheet.CellsSRC(Visio.visSectionReviewer, pag.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationReviewerID).ResultIU - 1, Visio.visReviewerInitials).ResultStr("")
sText = sText & pag.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationMarkerIndex).ResultIU
sText = sText & vbTab & Format(pag.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationDate).ResultIU, "ddddd")
sText = sText & vbTab & pag.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationComment).ResultStr("")
Next iRow
End If

For Each pagMarkup In pag.Document.Pages
If pagMarkup.Type = visTypeMarkup Then
If pagMarkup.OriginalPage = pag Then
If pagMarkup.PageSheet.SectionExists(Visio.visSectionAnnotation, Visio.visExistsAnywhere) Then
sText = sText & vbCrLf
sText = sText & vbCrLf & pag.Document.DocumentSheet.CellsSRC(Visio.visSectionReviewer, pagMarkup.ReviewerID - 1, Visio.visReviewerName).ResultStr("")
For iRow = 0 To pagMarkup.PageSheet.RowCount(Visio.visSectionAnnotation) - 1
sText = sText & vbCrLf & pag.Document.DocumentSheet.CellsSRC(Visio.visSectionReviewer, pagMarkup.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationReviewerID).ResultIU - 1, Visio.visReviewerInitials).ResultStr("")
sText = sText & pagMarkup.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationMarkerIndex).ResultIU
sText = sText & vbTab & Format(pagMarkup.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationDate).ResultIU, "ddddd")
sText = sText & vbTab & pagMarkup.PageSheet.CellsSRC(Visio.visSectionAnnotation, iRow, Visio.visAnnotationComment).ResultStr("")
Next iRow
End If
End If
End If
Next pagMarkup

Dim iAutoSize as Integer 'new
iAutoSize = pag.AutoSize 'new
pag.AutoSize = 0 'new
Set shp = pag.DrawRectangle(-pag.PageSheet.Cells("PageWidth").ResultIU, 0, 0, pag.PageSheet.Cells("PageHeight").ResultIU)
pag.AutoSize = iAutoSize 'new
shp.AddSection visSectionUser 'new
shp.AddNamedRow visSectionUser, "msvNoAutoSize", visTagDefault 'new
shp.CellsU("User.msvNoAutoSize").FormulaU = 1 'new
shp.Cells("Para.HorzAlign").Formula = "0"
shp.Cells("VerticalAlign").Formula = "0"
shp.Name = "Reviewers Comments"
shp.Text = sText
End Sub
4 اشخاص اعجابات بهذا

شارك هذه المشاركه


رابط المشاركه
شارك

2 اجابات علي هذا السؤال

  • 0

لم نتمكن من الوصول للشرح

شارك هذه المشاركه


رابط المشاركه
شارك
  • 0

السلام عليكم فى تطبيقات الاوفيس الاخري يمكن طباعة المراجعات و التعديلات التي تمت على الملف بعد اختيار Track changes و لكن الفيزيو 2010 لا يحوي هذه الامكانية و للتغلب على ذلك نستخدم هذا الكود اولا يتم ادراجه فى موديول فى الملف ثانيا يتم اختيار تتبع التعديلات ، ثم اضافة بعض الملاحظات و العلاممات Markup ( و سيتم شرح كيفية عمل ذلك فى الفيزيو خلال الدورة باذن الله لم لم يستخدم هذه الخاصية) و بعد ذلك يتم تشغيل الكود ، فيقوم بانشاء مربع نص ، و بسجل به التعديلات التى تمت

شارك هذه المشاركه


رابط المشاركه
شارك

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .


سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.


سجل دخولك الان

  • محتوي مشابه

    • بواسطه ابو عبدالرحمن بيرم
      بسم الله الرحمن الرحيم
      وبه نستعين
      السادة الزملاء الافاضل 
      السلام عليكم ورحمته الله وبركاته
      الكود التالى طلب للأخ الفاضل // ناصر المصرى
      على الرابط أدناه
       
      حيث يشمل الطلب على شقين حسب مافهمت منه عبر الخاص وقد وفقنى الله تعالى لتنفيذ الشق الاول ألا وهو
      منع وإخفاء وطباعة أوراق محددة فى مصنف
       أما عن الشق الثانى فقد حاولت فيه ولكن لم يوفقنى الله فى تنفيذه
       والتى تخص الاوراق من stor1 حتى stor10لذا يرجى من الاخ ناصر برفع موضوع جديد موضحا به الاضافة التى يريد إضافتها على الكود المشار اليه
      حتى يتمكن السادة الزملاء الافاضل بتقديم المساعدة
       تقبلوا وافر تقديرى واحترامى
      وجزاكم الله خيرا
      Option Explicit Sub Print_SalmaSaied() Dim CurVis As Long, sh As Worksheet, HidShts, S Application.ScreenUpdating = 0 HidShts = Array("List", "Add", "Main store", "Archives", "Collection items", "Suppliers", "Customers") For Each sh In ActiveWorkbook.Worksheets S = Application.Match(sh.Name, HidShts, 0) If Application.WorksheetFunction.CountBlank(sh.Range("A10:I10000")) <> sh.Range("A10:I10000").Count Then If IsError(S) Then With sh CurVis = .Visible If CurVis >= 0 Then .Visible = xlSheetVisible .PrintOut sh.Range("A10:I10000").ClearContents .Visible = CurVis End If End With End If End If Next sh End Sub منع وإخفاء وطباعة اوراق عمل محددة فى مصنف - سعيد بيرم.rar
    • بواسطه ناصرالمصرى
      السلام عليكم ورحمته الله وبركاته
      سؤال بعد إذن حضراتكم  بشأن طباعة مصنف يوجد به العديد من الصفحات المخفاه
      الملف بدون إخفاءات لتلك الصفحات يعمل بدون مشاكل أما بالإخفاءات تظهر رسائل خطأ
      فكيف يمكن التغلب عل هذة المشكلة أو ماهى الاضافة على أكواد الطباعة التى من شأنها
      تذليل تلك العقبة ***** شاكر فضل حضراتكم وجزاكم الله خيرا
      اعتذر عن رفع الموضوع مرتين لخطأ فنى بالنت لذا يرجى حذف أحد الرابطين
       
      مثال من ص 1 الى ص 8.rar
      مثال طباعة مع اخفاء صفحات مختلفه.rar
    • بواسطه ناصرالمصرى
      السلام عليكم ورحمته الله وبركاته
      سؤال بعد إذن حضراتكم  بشأن طباعة مصنف يوجد به العديد من الصفحات المخفاه
      الملف بدون إخفاءات لتلك الصفحات يعمل بدون مشاكل أما بالإخفاءات تظهر رسائل خطأ
      فكيف يمكن التغلب عل هذة المشكلة أو ماهى الاضافة على أكواد الطباعة التى من شأنها
      تذليل تلك العقبة ***** شاكر فضل حضراتكم وجزاكم الله خيرا
      اعتذر عن رفع الموضوع مرتين لخطأ فنى بالنت لذا يرجى حذف أحد الرابطين
        مثال من ص 1 الى ص 8.rar
      مثال طباعة مع اخفاء صفحات مختلفه.rar
    • بواسطه ناصر حسان
                                         أخواني الكرام


       
      ارجوا المساعدة فى كيفية طباعة اوراق فى شيت اكسيل حسب الاتجاة المطلوب كما هو موضح بالمرفق
      ولكم الشكر والاحترام 
      تحياتى للجميع
      طباعة.rar
    • بواسطه ُExcel Magic Trick
      السلام عليكم ورحمة الله وبركاتة
       
      الاخوة الزملاء
      السلام عليكم ورحمة الله وبركاتة
      ساشرح اليوم بطريقة بسيطة كيفية عمل زر الطباعة في الاكسيل 
      شرح بالفيديوهات مع الاكواد
       
       
  • المتواجدين الان   0 اعضاء متواجدين الان

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