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

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


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

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

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

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

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

سجل حساب جديد

تسجيل دخول

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

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

  • محتوي مشابه

    • بواسطه عاشق الاكسيل
      السلام عليكم ورحمة الله وبركاته
      تعريف بالملف :
      ملف مكون من 2 شيت ( Data - Print )
      شيت Data : بيانات الموظف والمبلغ والضريبة
      شيت Print : طباعة ايصالات استلام
      المطلوب :
      كود يقوم باستدعاء بيانات الموظف ومبلغه وضريبته ثم طباعته بشكل مستقل
      وذلك بدون تكرار شيت Print .
      الية تطبيق الكود :
      1- استدعاء بيانات الموظف
      2- طباعة الصفحة
      3- مسح البيانات واستدعاء الموظف الذى يليه وطباعته .
      وهكذا .......
       
      Print.xlsx
    • بواسطه waledms
      المرفق عند عمل معاينه للصف 2/3 لا يظهر آخر صفين فى الورقة ولا تظهر عند الطباعه
      ‏‏‏رصد الإتقان.rar
      لم أجد الحل فى المحتوى المشابه
    • بواسطه hesham eltohamy
      السلام عليكم
      اريد كود لزر امر يقوم بطباعة ملف مرتبط بكود العميل او باسم العميل
      بمعني اسم الملف يساوي كود العميل او اسمه
      مع جزيل الشكر
    • بواسطه علي المصري
      المرفق به
      فورم يحتوي على عدد 2 ليست بوكس
      احدهما لجلب اسماء الاوراق الموجودة في ملف الاكسيل
      يوجد ازرار تمكنك من ترحيل اسماء الاوراق التي تريد طباعتها او حفظها إلى الليست بوكس الاخر
      ومن ثم الضغط على زر الطباعة او الحفظ
      يمكنك اكتشاف الامر عمليا
      حمل المرفق وشاهد
       
       
      Print and Save As pdf Using ListBox in a UserForm.rar
    • بواسطه hana jabari
      عملت نموذج بحث ..لكن المشكلة إنه لا يطبع كل محتوى listbox
      جربت أكواد كثيرة ولكن بلا جدوى 
      أريد كود لطباعة كل محتوى list box وليس الفورم 
      مشروعي اكسل vba
  • المتواجدين الان   0 اعضاء متواجدين الان

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

×