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

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

Recommended Posts

يحتوى برنامج الفيزيو 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
  • Like 4

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


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

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

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


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

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

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


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

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

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


  • محتوي مشابه

    • بواسطه hesham eltohamy
      السلام عليكم
      اريد كود لزر امر يقوم بطباعة ملف مرتبط بكود العميل او باسم العميل
      بمعني اسم الملف يساوي كود العميل او اسمه
      مع جزيل الشكر
    • بواسطه علي المصري
      المرفق به
      فورم يحتوي على عدد 2 ليست بوكس
      احدهما لجلب اسماء الاوراق الموجودة في ملف الاكسيل
      يوجد ازرار تمكنك من ترحيل اسماء الاوراق التي تريد طباعتها او حفظها إلى الليست بوكس الاخر
      ومن ثم الضغط على زر الطباعة او الحفظ
      يمكنك اكتشاف الامر عمليا
      حمل المرفق وشاهد
       
       
      Print and Save As pdf Using ListBox in a UserForm.rar
    • بواسطه hana jabari
      عملت نموذج بحث ..لكن المشكلة إنه لا يطبع كل محتوى listbox
      جربت أكواد كثيرة ولكن بلا جدوى 
      أريد كود لطباعة كل محتوى list box وليس الفورم 
      مشروعي اكسل vba
    • بواسطه حسين مامون
      السلام عليكم
      في النمودج بالمرفق  مكتوبة افقيا
      اريد عند ادخال رقم الشهر في التسكست بوكس7 
       ثم النقر على  زرطباعة في الفورم  تطبع البيانات التي حدثث في نفس الشهر
      ارقام الشهور  في الصف2 
      جزاكم الله خيرا
      مصاريف النقل.rar
    • بواسطه Aliko
      السلام عليكم ورحمة الله وبركاته 
      اخواني الافاضل 
      لدي نموذج في قاعدة البيانات واريد ان اطبع الصفحه الاخيره المفتوحه لهذا النموذج 
      !!!!
      حاولت ان بطريقة ان اطبع هذا النموذج لكن البرنامج يقوم بطباعة جميع الصفحات تواليا وانا احتاج لطباعة النموذج المفتوح والبيانات المكتوبه اخر شيء ؟ 
      هل توجد اي طريقه او كود لطباعة النموذج الاخير فقط دون طباعه البيانات السابقه ؟ 
      وبنفس الطريقه هل توجد طريقه لحفظ الصفحه الاخيره من النموذج بصيغه ال بي دي اف ؟ 
      للمعلومه انا احتاج لطباعه النموذج وليس للتقرير 
      اتمنى مساعدتكم اخواني الافاضل 
      تحياتي وشكري لكم جميعاً 
      اخوكم 
      ٧/٧/٢٠١٧
  • المتواجدين الان   0 اعضاء متواجدين الان

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

×