بحث مخصص من جوجل فى أوفيسنا
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 ( و سيتم شرح كيفية عمل ذلك فى الفيزيو خلال الدورة باذن الله لم لم يستخدم هذه الخاصية) و بعد ذلك يتم تشغيل الكود ، فيقوم بانشاء مربع نص ، و بسجل به التعديلات التى تمت

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


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

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

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

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

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


سجل حساب جديد

تسجيل دخول

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


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

  • محتوي مشابه

    • بواسطه Aliko
      السلام عليكم ورحمة الله وبركاته 
      اخواني الافاضل 
      لدي نموذج في قاعدة البيانات واريد ان اطبع الصفحه الاخيره المفتوحه لهذا النموذج 
      !!!!
      حاولت ان بطريقة ان اطبع هذا النموذج لكن البرنامج يقوم بطباعة جميع الصفحات تواليا وانا احتاج لطباعة النموذج المفتوح والبيانات المكتوبه اخر شيء ؟ 
      هل توجد اي طريقه او كود لطباعة النموذج الاخير فقط دون طباعه البيانات السابقه ؟ 
      وبنفس الطريقه هل توجد طريقه لحفظ الصفحه الاخيره من النموذج بصيغه ال بي دي اف ؟ 
      للمعلومه انا احتاج لطباعه النموذج وليس للتقرير 
      اتمنى مساعدتكم اخواني الافاضل 
      تحياتي وشكري لكم جميعاً 
      اخوكم 
      ٧/٧/٢٠١٧
    • بواسطه esnad
      بسم الله الرحمن الرحيم
      السلام عليكم ورحمة الله وبر كاته 
      امل منكم اخواني الكرام مساعدتي في الشرح لي عن طرية ضبط الطباعة في الاكسس لنموذج معد على ادخال بيانات وطباعتها على فواتير بديل عن الكتابه باليد 
      مع العلم اني لا توجد لدي المعرفة في طريقة القياس للصفحة او وضع الاماكن بالتحديد في التقرير للطباعة 
       
      هذا ولكم الشكر 
      وامل ان وفقت بشرح سؤالي تحياتي مع الشكر مره اخرى 
       
    • بواسطه AymenShaban
      السلام عليكم ورحمة الله وبركاته
       
      اخواني الاعزاء
      هل من طريقة عند طباعة اي تقرير تظهر خصائص الطابعة كما مرفق في الصورة 
      لتحديد عدد مرات الطباعة او اختيار نوع الطابعة.
      ولكم جزيل الشكر

    • بواسطه ابو عبدالرحمن بيرم
      بسم الله الرحمن الرحيم
      وبه نستعين
      السادة الزملاء الافاضل 
      السلام عليكم ورحمته الله وبركاته
      الكود التالى طلب للأخ الفاضل // ناصر المصرى
      على الرابط أدناه
       
      حيث يشمل الطلب على شقين حسب مافهمت منه عبر الخاص وقد وفقنى الله تعالى لتنفيذ الشق الاول ألا وهو
      منع وإخفاء وطباعة أوراق محددة فى مصنف
       أما عن الشق الثانى فقد حاولت فيه ولكن لم يوفقنى الله فى تنفيذه
       والتى تخص الاوراق من 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
  • المتواجدين الان   0 اعضاء متواجدين الان

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