יצירת קבצי TTS - לטריוויה ב- VBA

צבי 10

מהיום קל ופשוט ליצור קבצי TTS לטריוויה.
קרדיט ל@מאקרו מפורום אופיס.
ימות המשיח אמרו, שאין לעת עתה אפשרות TTS בטריוויה, אתכם הסליחה.

פותחים קובץ וורד
מקלידים את השאלה ו-4 תשובות, כל אחד בשורה נפרדת. (באנטר).
פותחים את כרטיסיית "מפתחים". (באם היא לא מוצגת, ניתן להציגה ב קובץ>אפשרויות>התאמה אישית של רצועת הכלים. ולסמן ב-V את "מפתחים"
פותחים את VB מעתיקים את הקוד הבא לחלון שנפתח. שומרים, וסוגרים את החלון.
פותחים את "פקודות מאקרו", ומפעילים את TriviaFiles.
התוצאה: תיקייה בנתיב - c:\trivia\1\000 שבה יש 5 קבצי TTS מוכנים.
אפשר כמובן לפתח את הרעיון, להעתיק לעוד כמה שאלות, ולשנות את הקוד כרצונכם... למי שיודע.
בדוגמא כאן: "1"- תיקיית מבחן. "000"- תיקיית שאלות ותשובות.

Sub TriviaFiles()

'בודק האם קיימת תיקייה לקבצים. אם לא צור תיקייה חדשה.
If Dir("c:\Trivia", vbDirectory) = "" Then MkDir "c:\Trivia"
If Dir("c:\Trivia\1", vbDirectory) = "" Then MkDir "c:\Trivia\1"
If Dir("c:\Trivia\1\000", vbDirectory) = "" Then MkDir "c:\Trivia\1\000"
'מגדיר את הספרייה הנוכחית ל- C:
ChDir "c:\Trivia\1\000"
 
'שומר כל שורה בקובץ, בתור קובץ שאלה, ו-4 תשובות
For i = 1 To 5
    f = Choose(i, "Q", "A", "B", "C", "D")
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    TTS = Selection
    Open f & ".tts" For Output As #1
    Write #1, TTS
    Close #1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
Next
 
End Sub

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

clickphone

@צבי-10 זה אכן פותח קבצים אבל לא כתוב כלום מלבד " "

צבי 10

@clickphone כתבת בוורד עצמו 5 שורות עם טקסט, כאשר כל שורה מופרדת באמצעות "אנטר"?

clickphone

@צבי-10 אכן

שרות פלוס IVR

@צבי-10 תודה רבה
מה שרצו זה גם לשנות הודעות מערכת במודול הטריוויה
יש כמה שזה בקול נשי.

צבי 10

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

גוטליב סוכן פלאפונים

@צבי-10 אמר ביצירת קבצי TTS - לטריוויה ב- VBA:

מהיום קל ופשוט ליצור קבצי TTS לטריוויה.
קרדיט ל@מאקרו מפורום אופיס.

פותחים קובץ וורד

מקלידים את השאלה ו-4 תשובות, כל אחד בשורה נפרדת. (באנטר).

פותחים את כרטיסיית "מפתחים". (באם היא לא מוצגת, ניתן להציגה ב קובץ>אפשרויות>התאמה אישית של רצועת הכלים. ולסמן ב-V את "מפתחים"

פותחים את VB מעתיקים את הקוד הבא לחלון שנפתח. שומרים, וסוגרים את החלון.

פותחים את "פקודות מאקרו", ומפעילים את TriviaFiles.
התוצאה: תיקייה בנתיב - c:\trivia\1\000 שבה יש 5 קבצי TTS מוכנים.
אפשר כמובן לפתח את הרעיון, להעתיק לעוד כמה שאלות, ולשנות את הקוד כרצונכם... למי שיודע.
בדוגמא כאן: "1"- תיקיית מבחן. "000"- תיקיית שאלות ותשובות.
Sub TriviaFiles()

'בודק האם קיימת תיקייה לקבצים. אם לא צור תיקייה חדשה.
If Dir("c:\Trivia", vbDirectory) = "" Then MkDir "c:\Trivia"
If Dir("c:\Trivia\1", vbDirectory) = "" Then MkDir "c:\Trivia\1"
If Dir("c:\Trivia\1\000", vbDirectory) = "" Then MkDir "c:\Trivia\1\000"
'מגדיר את הספרייה הנוכחית ל- C:
ChDir "c:\Trivia\1\000"
 
'שומר כל שורה בקובץ, בתור קובץ שאלה, ו-4 תשובות
For i = 1 To 5
    f = Choose(i, "Q", "A", "B", "C", "D")
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    TTS = Selection
    Open f & ".tts" For Output As #1
    Write #1, TTS
    Close #1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
Next
 
End Sub
בהצלחה לכולם.
@שמחה-זו-הסיסמא @ימות-המשיח תזיז את הנושא לקטגוריה המתאימה.

מישהו מוכן להסביר לי מה זה VB ואיפה אמור להיות כרטיסיה מפתחים?

צבי 10

@גוטליב-סוכן-פלאפונים
שפת תכנות VBA של אופיס עיין כאן
ניתן להציגה ב קובץ>אפשרויות>התאמה אישית של רצועת הכלים. ולסמן ב-V את "מפתחים" שנמצא בטור השמאלי.

גוטליב סוכן פלאפונים

@צבי-10 אמר ביצירת קבצי TTS - לטריוויה ב- VBA:

@גוטליב-סוכן-פלאפונים
ניתן להציגה ב קובץ>אפשרויות>התאמה אישית של רצועת הכלים. ולסמן ב-V את "מפתחים" שנמצא בטור השמאלי.

באתר ניהול המערכת?

צבי 10

@גוטליב-סוכן-פלאפונים לא.
זה לא קשור לימות המשיח. אלא למעבד תמלילים כלשהו.
במקרה שלנו אנחנו משתמשים בתוכנת וורד כדי ליצור קבצי TTS בקלות ובמהירות, ע"י פקודות המחלקות כל שורה לקובץ נפרד.

גוטליב סוכן פלאפונים

@צבי-10 אמר ביצירת קבצי TTS - לטריוויה ב- VBA:

@clickphone כתבת בוורד עצמו 5 שורות עם טקסט, כאשר כל שורה מופרדת באמצעות "אנטר"?

כן ואיפה אני מעלה את הקובץ? בשלוחת הטריוויה במערכת?

צבי 10

@גוטליב-סוכן-פלאפונים כן.
את תיקייה מס' 1 שבתוכה קבצי ה- TTS מעלים. ותשנה את שם התיקייה לפי הגדרות הטריוויה

גוטליב סוכן פלאפונים

@צבי-10 אמר ביצירת קבצי TTS - לטריוויה ב- VBA:

@גוטליב-סוכן-פלאפונים כן.
את תיקייה מס' 1 שבתוכה קבצי ה- TTS מעלים. ותשנה את שם התיקייה לפי הגדרות הטריוויה

בתוך שלוחת הטריוויה אני צריך לפתוח שלוחה חדשה ולשם להכניס את כל השאלות?

צבי 10

@גוטליב-סוכן-פלאפונים כן ככה זה עובד תסתכל בהגדרות כאן

צבי 10

עידכונים ושיפורים בקוד מבית @מאקרו. עידכונים נוספים בקרוב...
השיפורים בקוד זה הם:

אפשרות לבחור כמות תשובות
עובר על כל הפסקאות במסמך ויוצר תיקיות בסדר עוקב (“001”,“002”)
לפני תחילת הפעולה מקפיץ את הסמן לתחילת המסמך, (שלא יווצר מצב שאדם הקליד רשימת שאלות ותשובות ועומד כרגע בסוף המסמך, ואז הטריוויה תתחיל מהסוף…)
מי שיש לו רעיונות לשיפור הקוד - כאן זה המקום.

 Sub TriviaFiles()
 
'בודק האם קיימת תיקייה לקבצים. אם לא צור תיקייה חדשה.
If Dir("c:\Trivia", vbDirectory) = "" Then MkDir "c:\Trivia"
If Dir("c:\Trivia\1", vbDirectory) = "" Then MkDir "c:\Trivia\1"
 
Count = InputBox("הזן כמות תשובות לשאלה", "")
Selection.HomeKey Unit:=wdStory
QDir = 0
 
Do While Selection.Range.End <> ActiveDocument.Content.End - 1
    QDir = Format(QDir, "000")
    CDir = "c:\Trivia\1\" & QDir
    If Dir(CDir, vbDirectory) = "" Then MkDir CDir
    ChDir CDir
    
    'שומר כל שורה בקובץ, בתור קובץ שאלה, ו-4 תשובות
    For i = 1 To Count + 1
        f = Choose(i, "Q", "A", "B", "C", "D")
        Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
        TTS = Selection
        Open f & ".tts" For Output As #1
        Write #1, TTS
        Close #1
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Next
    QDir = QDir + 1
Loop
End Sub
{1}

בסייעתא דשמיא 0

סליחה על השאלה הפשוטה, אך אני ניסיתי הרבה פעמים להעלות קבצי TTS פשוטים [באתר החדש - העלאת קובץ TTS] ולא הצלחתי לשמוע אותם אלא המערכת לא התייחסה לקבצים, [במבחן אמריקאי בטח ניסיתי עשרות פעמים, ונראה לי גם בטריוויה], האם הם אמורים לעבוד בטריוויה בדרך כלל?

צבי 10

@בסייעתא-דשמיא-0 את האמת, עוד לא ניסיתי את האופציה, כי אני עסוק בדברים אחרים, רק בדקתי שהקוד יוצר את הקבצים במחשב, לגבי פעילוות TTS בשלוחת טריוויה -אין לי מושג, מצטער. (בתפריט ראשי M0000 כן עבד לי TTS.)

בסייעתא דשמיא 0

@צבי-10
גם שאלתי בשרות הלקוחות במייל וענו לי שאין אפשרות TTS בטריוויה רק WAV.

מנסה

@צבי-10

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

צבי 10

@בסייעתא-דשמיא-0 טוב, לא ידעתי. אני משנה למעלה.
@מנסה אני לא יודע API, אולי מישהו אחר בפורום. ואם עובד לך FTP / תקשור עם מערכת דרך אקסס, אתה יכול להעלות משם.

	Sub TriviaFiles()

	'בודק האם קיימת תיקייה לקבצים. אם לא צור תיקייה חדשה.
	If Dir("c:\Trivia", vbDirectory) = "" Then MkDir "c:\Trivia"
	If Dir("c:\Trivia\1", vbDirectory) = "" Then MkDir "c:\Trivia\1"

	Count = InputBox("הזן כמות תשובות לשאלה", "")
	Selection.HomeKey Unit:=wdStory
	QDir = 0

	Do While Selection.Range.End <> ActiveDocument.Content.End - 1
	QDir = Format(QDir, "000")
	CDir = "c:\Trivia\1\" & QDir
	If Dir(CDir, vbDirectory) = "" Then MkDir CDir
	ChDir CDir

	'שומר כל שורה בקובץ, בתור קובץ שאלה, ו-4 תשובות
	For i = 1 To Count + 1
	f = Choose(i, "Q", "A", "B", "C", "D")
	Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
	TTS = Selection
	Open f & ".tts" For Output As #1
	Write #1, TTS
	Close #1
	Selection.MoveRight Unit:=wdCharacter, Count:=1
	Next
	QDir = QDir + 1
	Loop
	End Sub
	{1}