פונט פונקציה להצגת כל הפונטים שעל המחשב!

[אישאשכולות]

למישהו יש מאקרו לפונטים? תודה ושבוע טוב..

 

[RCpro]

תעשה חיפוש בפורום, כבר העלו סקריפט לוורד.

 

[אישאשכולות]

קודם כל תודה, אבל תן לי מילת מפתח! שוב תודה

 

[אביגדורית]

אני לא הסתדרתי לעבוד עם זה עדיין, אולי אם אתה תצליח תעזור לי. אני חלש בדברים האלו...
http://www.prog.co.il/showthread.php?t=5493

(לא יותר פשוט לכתוב: למישהו יש מאקרו לפונטים? תודה ושבוע טוב...)

 

[אישאשכולות]

(לא יותר פשוט לכתוב: למישהו יש מאקרו לפונטים? תודה ושבוע טוב...)

אתה פשוט צודק.

אבל שמע, כששאלתי בעצת גרפיקאי ותיק, הוא לא הצליח לעזור לי ולהבין מה אני צריך, רק כשתארתי לו את התהליך. אבל, הצדק אתך.

 

[אישאשכולות]

אני לא הסתדרתי לעבוד עם זה עדיין, אולי אם אתה תצליח תעזור לי. אני חלש בדברים האלו...

אביגדור, זה ענק!!!

רק שתבין, יש לי כמות ענקית של גופנים "דפוקים", או כאלה שסטודנטים התאמנו, ושחררו את זה לכל מאן דבעי. כך או כך, בעשר דקות שהמאקרו עבד, חסכתי אין ספור "שריפות זמן". ע נ ק !

איך עושים את זה? אז ככה זה עם התמונות.
1. כאן נכנסים לספריית המאקרו
2. כאן יוצרים או עורכים פקודות מאקרו. בענינינו: "צור"
3. כאן, בחלון שנפתח מדביקים את הטקסט שהעתקנו מהאתר.
4. וכאן! לא שוכחים להודות ל"טיפוגרף" על החסד העצום שעשה עמנו!


(ונתנו 10 מסביר את זה די טוב באשכול שלשם שלחת אותי).

 

[studio dv.d]

אגב אם תפתחו את הפקודת מאקרו ותמחקו רק את המילים "כך נפץ התרסק על גוזל קטן שדחף את צבי למים " משהו כזה ותשמרו כל משפט אחר במקום או תכתבו משפט באנגלית במקום ואז תעשו הפעל אז הוא יתן תוצאה של המשפט שאתם הכנסתם ואז תראו גם איזה פונט הוא אנגלית

 

[אביגדורית]

אישאשכולות, תודה רבה. אבל לשלב הזה גם אני הגעתי השאלה איך ממשיכים הלאה עד לתוצאה המבוקשת?

ושוב, אני ממש חלש בדברים האלו.

 

[GQSC]

גם אני כמו אביגדור מחכה לדעת...

תודה אביגדור על העבודה שאתה עושה בשבילי.

 

[ונתנו10]

אתה בוחר את המאקרו, ועורך אותו ע"י הפקודה של "ערוך מאקרו" שנמצא ב: ALT+F8

 

[אישאשכולות]

אישאשכולות, תודה רבה. אבל לשלב הזה גם אני הגעתי השאלה איך ממשיכים הלאה עד לתוצאה המבוקשת?

ושוב, אני ממש חלש בדברים האלו.

את החלון האחרון (היכן שהדבקת את הטקסט - הסקריפט - שלקחת מהאתר) את סוגר את החלון הזה, וחוזר לחלון שבשלב 3 "פקודות מאקרו", ומפעיל את המאקרו שלנו. "ListAllFonts".

אביגדור ידידי, אם עדיין לא הבנת, תשאל אותי שוב. מגיע לך ממני הרבה הכרת הטוב. חסכת לי הרבה עבודה!

א"א


כדי לחסוך לך להתרוצץ בין הלינקים, העתקתי לפה את המאקרו של טיפוגרף. הוא ודאי יודה לי על שמעיינותיו מופצים חוצה.



Sub ListAllFonts()
Dim oDoc As Word.Document
Dim oTable As Word.Table
Dim iCnt As Long

If MsgBox("Do you wish to build a list?" & vbCr & _
"Building a list on older systems this may take a while" & vbCr & _
vbCr & "Screen may appear frozen" & vbCr & _
"Please wait for the list to complete", _
vbQuestion + vbYesNo, "Built Font list") = vbYes Then

Application.ScreenUpdating = False

'Create new doc to list font's
Set oDoc = Application.Documents.Add

'Create table of 2 columns and as many rows as there are fontnames
Set oTable = oDoc.Tables.Add(Range:=Selection.Range, _
NumRows:=Application.FontNames.Count + 1, _
NumColumns:=4)
With oTable
'Create table header
With .Cell(1, 1).Range
.Font.Name = "OGENBLACK"
.Font.Bold = True
.InsertAfter "שם הפונט"
End With

With .Cell(1, 2).Range
.Font.Name = "OGENBLACK"
.Font.Bold = True
.InsertAfter "תצוגת הפונט"
End With

With .Cell(1, 3).Range
.Font.Name = "OGENBLACK"
.Font.Bold = True
.InsertAfter "טקסט קצר"
End With

With .Cell(1, 4).Range
.Font.Name = "OGENBLACK"
.Font.Bold = True
.InsertAfter "שם הפונט"
End With

'Loop through Fontnames
For iCnt = 1 To Application.FontNames.Count
'Add Fontname to cell
With .Cell(iCnt + 1, 1).Range
.Font.Name = "Arial"
.Font.Size = 10
.InsertAfter Application.FontNames(iCnt)
End With

'Set Font in Cell to Fontname and insert example text
With .Cell(iCnt + 1, 2).Range
.Font.Name = Application.FontNames(iCnt)
.Font.Size = 10
.InsertAfter "אבגדהוזחטיכלמנסעפצקרשת כםןףץ 1234567890 (?!)"
End With

'Set Font in Cell to Fontname and insert example text
With .Cell(iCnt + 1, 3).Range
.Font.Name = Application.FontNames(iCnt)
.Font.Size = 16
.InsertAfter "כך נפץ התרסק על גוזל קטן שדחף את צבי למים"
End With


'Set Font in Cell to Fontname and insert example text
With .Cell(iCnt + 1, 4).Range
.Font.Name = oTable.Cell(iCnt + 1, 3).Range.Font.Name
.Font.Size = 10
If .Font.Name = "Tahoma" Then oTable.Cell(iCnt + 1, 4).Row.Delete


.InsertAfter "פונט עברי"
End With

Next iCnt

'No borders and sort table Ascending
.Borders.Enable = False
.Sort SortOrder:=wdSortOrderAscending
End With
End If
End Sub

 

[GQSC]

תודה רבה לך מאוד מאוד עזרת לי וחסכת לי זמן יקר

 

[אביגדורית]

אני לא הבנתי, לא נעים לי אבל פשוט תלך איתי כמו שהולכים עם ילד בן ארבע.

לפתוח וורד. מה הלאה? מצחיק? אההה.

 

[מעיינות21]

הוא הבין..

 

[מעיינות21]

ואוו זה ע-נ-ק!
אביגדור אני ממליצה בחום!

 

[מיכל וובר]

רק אצלי זה תוקע את הוורד?

 

[מעיינות21]

לא גמלי קרה.
סגרי ת'תוכנה (סיים כעת)
ותפתחי שוב וזה יופיע אוטומטית

 

[מעיינות21]

אל תסגרי
זה בגלל שיש לך מלא פונטים

 

[מעיינות21]

סליחה!

 

[מיכל וובר]

קבלי ביטול - - -



כניראה יש הרבה פונטים וזה לקח יותר מחצי דקה - - -
עכשיו עובד מצויין, תודה!