معرفة الخطوط المستخدمة في مستند وورد بطريقة سريعه

God bless the VBA

كود يبحث حرف بحرف داخل المستند ويعود بالخطوط المستخدمة

Public Sub ListFontsInDoc()
	Dim FontList(199) As String
	Dim FontCount As Integer
	Dim FontName As String
	Dim J As Integer, K As Integer, L As Integer
	Dim X As Long, Y As Long
	Dim FoundFont As Boolean
	Dim rngChar As Range
	Dim strFontList As String

	FontCount = 0
	X = ActiveDocument.Characters.Count
	Y = 0
	' For-Next loop through every character
	For Each rngChar In ActiveDocument.Characters
		Y = Y + 1
		FontName = rngChar.Font.Name
		StatusBar = Y & ":" & X
		' check if font used for this char already in list
		FoundFont = False
		For J = 1 To FontCount
		   If FontList(J) = FontName Then FoundFont = True
		Next J
		If Not FoundFont Then
			FontCount = FontCount + 1
			FontList(FontCount) = FontName
		End If
	Next rngChar

	' sort the list
	StatusBar = "Sorting Font List"
	For J = 1 To FontCount - 1
		L = J
		For K = J + 1 To FontCount
			If FontList(L) > FontList(K) Then L = K
		Next K
		If J <> L Then
			FontName = FontList(J)
			FontList(J) = FontList(L)
			FontList(L) = FontName
		End If
	Next J

	StatusBar = ""
	' put in new document
	Documents.Add
	Selection.TypeText Text:="There are " & FontCount & " fonts used in the document, as follows:"
	Selection.TypeParagraph
	Selection.TypeParagraph
	For J = 1 To FontCount
		Selection.TypeText Text:=FontList(J)
		Selection.TypeParagraph
	Next J
End Sub

كود خطير و فعال يبدو ذلك من شكله لكني لا اعرف vba اين يمكن ان يضاف هذا الكود

عن طريق إضافة ماكرو إلي المشروع ووضع الكود به وتشغيله

وعند الانتهاء سيقوم بفتح نافذة مستند جديدة بها الخطوط الموجودة مرتبة أبجديا

http://office.microsoft.com/en-us/word/HA100997691033.aspx

http://www.word07.com/creating-macros.htm

قم بإنشاء الماكرو بأسم ListFonts مثلا وتجاهل خيارات تسجيل الماوس أو الكيبورد وقم بفتح نافذة تحرير VBA مباشرة وضع كود الإجراء السابق تحت إجراء الماكرو ListFonts المسجل وقم بتشغيله من زر Run

ويمكن عمل ذلك برمجيا من خلال الفيجول بيسيك أيضا

http://support.microsoft.com/kb/219905/

http://support.microsoft.com/kb/219905/ar

الحياة إيزي جدا مع ميكو