מרחב למידה

מרחב פתוח לשאלות ועזרה הדדית בחו"ד עיצובית
מנהל הפורום: אלעזר 1
חו"ד ליצירות ועבודות, שאלות טכניות על תוכנות אדובי, הבאה לדפוס, מדריכים, זיהוי פונטים ומאגרים חינמיים.
הוסף נושא חדש

עיצוב ותקשורת חזותית >> תוכן מקצועי

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

    הנה הוא

    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
     תגובה אחרונה 
    א
    אליהו פריד
    הנה קובץ וורד ..
    איזה תמונה אפשר לשים למודעת פרסום לסטודיו לאומנות, כשהמסר שהלקוח רוצה להעביר הוא שמשנה לשנה יש התקדמות ברמת העבודות?

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

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

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

    אולי שייך לפורום פרסום, אבל פה בטוח (בעז"ה) אקבל עזרה.

    ושוב, א. לא להוציא פרטים מגבולות הפורום.
    ב. בעז"ה אראה לכם את העבודה בהמשך.

    תודה רבה

    הצטרפות לניוזלטר

    איזה כיף שהצטרפתם לניוזלטר שלנו!

    מעכשיו, תהיו הראשונים לקבל את כל העדכונים, החדשות, ההפתעות בלעדיות, והתכנים הכי חמים שלנו בפרוג!

    לוח מודעות

    הפרק היומי

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


    תהילים פרק כה

    אלְדָוִד אֵלֶיךָ יי נַפְשִׁי אֶשָּׂא:באֱלֹהַי בְּךָ בָטַחְתִּי אַל אֵבוֹשָׁה אַל יַעַלְצוּ אֹיְבַי לִי:גגַּם כָּל קוֶֹיךָ לֹא יֵבֹשׁוּ יֵבֹשׁוּ הַבּוֹגְדִים רֵיקָם:דדְּרָכֶיךָ יי הוֹדִיעֵנִי אֹרְחוֹתֶיךָ לַמְּדֵנִי:ההַדְרִיכֵנִי בַאֲמִתֶּךָ וְלַמְּדֵנִי כִּי אַתָּה אֱלֹהֵי יִשְׁעִי אוֹתְךָ קִוִּיתִי כָּל הַיּוֹם:וזְכֹר רַחֲמֶיךָ יי וַחֲסָדֶיךָ כִּי מֵעוֹלָם הֵמָּה:זחַטֹּאות נְעוּרַי וּפְשָׁעַי אַל תִּזְכֹּר כְּחַסְדְּךָ זְכָר לִי אַתָּה לְמַעַן טוּבְךָ יי:חטוֹב וְיָשָׁר יי עַל כֵּן יוֹרֶה חַטָּאִים בַּדָּרֶךְ:טיַדְרֵךְ עֲנָוִים בַּמִּשְׁפָּט וִילַמֵּד עֲנָוִים דַּרְכּוֹ:יכָּל אָרְחוֹת יי חֶסֶד וֶאֱמֶת לְנֹצְרֵי בְרִיתוֹ וְעֵדֹתָיו:יאלְמַעַן שִׁמְךָ יי וְסָלַחְתָּ לַעֲוֹנִי כִּי רַב הוּא:יבמִי זֶה הָאִישׁ יְרֵא יי יוֹרֶנּוּ בְּדֶרֶךְ יִבְחָר:יגנַפְשׁוֹ בְּטוֹב תָּלִין וְזַרְעוֹ יִירַשׁ אָרֶץ:ידסוֹד יי לִירֵאָיו וּבְרִיתוֹ לְהוֹדִיעָם:טועֵינַי תָּמִיד אֶל יי כִּי הוּא יוֹצִיא מֵרֶשֶׁת רַגְלָי:טזפְּנֵה אֵלַי וְחָנֵּנִי כִּי יָחִיד וְעָנִי אָנִי:יזצָרוֹת לְבָבִי הִרְחִיבוּ מִמְּצוּקוֹתַי הוֹצִיאֵנִי:יחרְאֵה עָנְיִי וַעֲמָלִי וְשָׂא לְכָל חַטֹּאותָי:יטרְאֵה אוֹיְבַי כִּי רָבּוּ וְשִׂנְאַת חָמָס שְׂנֵאוּנִי:כשָׁמְרָה נַפְשִׁי וְהַצִּילֵנִי אַל אֵבוֹשׁ כִּי חָסִיתִי בָךְ:כאתֹּם וָיֹשֶׁר יִצְּרוּנִי כִּי קִוִּיתִיךָ:כבפְּדֵה אֱלֹהִים אֶת יִשְׂרָאֵל מִכֹּל צָרוֹתָיו:
    נקרא  2  פעמים
    למעלה