בקשה | תוסף לוורד לזיהוי ועיצוב Markdown

[106]

שלום וברכה
כידוע דפי אינטרנט ובפרט צ'אטים של AI משתמשים לרוב בקוד Markdown כדי לעצב את הטקסט.
הבעיה היא, שכשמעתיקים אותו לוורד הוא נהפך לכוכביות וכו'.

האם יש תוסף לוורד הממיר Markdown לטקסט מעוצב?
ואם אין - האם אפשר ליצור משהו כזה?
תודה רבה

Spoiler

מה זה Markdown?
האפשרות 'העתק כ-Markdown' (Copy as Markdown) היא פקודה המאפשרת לך להעתיק טקסט מעוצב (כמו טקסט עם בולדים, כותרות, טבלאות או קישורים) ולהמיר אותו באופן אוטומטי לקוד בפורמט Markdown.

להלן הסבר על המשמעות והתועלת של הפעולה:

מה זה Markdown?

Markdown היא שפת סימון קלה ופשוטה שנועדה לאפשר כתיבת טקסט מעוצב באמצעות תווים רגילים. למשל:

• במקום ללחוץ על כפתור "B", כותבים **טקסט מודגש**.
• במקום ליצור טבלה מורכבת, משתמשים בקווים אנכיים (|) וסימני מינוס (-).

למה להשתמש ב'העתק כ-Markdown'?

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

• יישומי ניהול ידע: כמו Notion, Obsidian או Roam Research.
• פלטפורמות פיתוח: כמו GitHub או Stack Overflow.
• עורכי טקסט מתקדמים: המאפשרים המרה מהירה של הקוד למסמך PDF או HTML מעוצב.

איך זה נראה בפועל?

אם תעתיק כותרת ורשימה בפורמט הזה, הטקסט שייכנס לזיכרון של המחשב (Clipboad) ייראה כך:

## כותרת לדוגמה
* פריט ראשון ברשימה
* פריט שני **מודגש**

[צדיק תמים]

בגוגל דוקס יש מובנה העתקה מmd והורדה כmd

[106]

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

[צדיק תמים]

@106 זה לא אוטומטי

[אהרן]

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

[975]

@106
תנסה את זה

Sub MarkdownMaster_Smart_Final()
    Dim para As Paragraph
    Dim r As Range
    Dim IsSingleStarBold As Boolean    
    IsSingleStarBold = True 
    If MsgBox("להתחיל בעיבוד? (הוגדר: כוכבית אחת = " & IIf(IsSingleStarBold, "מודגש", "נטוי") & ")", vbOKCancel) = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    CleanBrowserArtifacts
    For Each para In ActiveDocument.Paragraphs
        Set r = para.Range
        If Len(r.Text) > 2 Then
            HandleHeadingsAndQuotes r
            FormatByPattern r, "\*\*\?([!\*]@)\*\*\?", True, False
            FormatByPattern r, "([! \*\^13])\*([!\*]@)\*", IsSingleStarBold, Not IsSingleStarBold
            FormatByPattern r, "\~\~([!\~]@)\~\~", False, False, True
            FormatByPattern r, "\`([!\`]@)\`"
        End If
    Next para
    
    Application.ScreenUpdating = True
    MsgBox "הסתיים בהצלחה!", vbInformation
End Sub

Sub FormatByPattern(rng As Range, pattern As String, Optional bBold As Boolean = False, Optional bItalic As Boolean = False, Optional bStrike As Boolean = False)
    Dim findRng As Range
    Set findRng = rng.Duplicate
    With findRng.Find
        .ClearFormatting
        .Text = pattern
        .MatchWildcards = True
        Do While .Execute
            If Not findRng.InRange(rng.Paragraphs(1).Range) Then Exit Do
            If bBold Then findRng.Font.Bold = True
            If bItalic Then findRng.Font.Italic = True
            If bStrike Then findRng.Font.StrikeThrough = True
            If pattern Like "*\`*" Then 
                findRng.Font.Name = "Courier New"
                findRng.Font.ColorIndex = wdRed
            End If
            RemoveSymbolsFromRange findRng, pattern
            findRng.Collapse wdCollapseEnd
        Loop
    End With
End Sub

Sub RemoveSymbolsFromRange(r As Range, pattern As String)
    Dim txt As String, firstChar As String, lastChar As String
    txt = r.Text
    If Left(pattern, 2) = "\*" Or Left(pattern, 2) = "\~" Or Left(pattern, 2) = "\_" Then
        If Left(r.Text, 2) = "**" Or Left(r.Text, 2) = "~~" Then
            r.Text = Mid(txt, 3, Len(txt) - 4)
        Else
            r.Text = Mid(txt, 2, Len(txt) - 2)
        End If
    Else
        Dim content As String
        content = Mid(txt, 3, Len(txt) - 3)
        r.Text = Left(txt, 1) & content
    End If
End Sub
Sub CleanBrowserArtifacts()
    Dim v As Variant
    For Each v In Array(8203, 8204, 8205)
        With ActiveDocument.Content.Find
            .Text = ChrW(v): .Replacement.Text = "": .Execute Replace:=wdReplaceAll
        End With
    Next v
End Sub
Sub HandleHeadingsAndQuotes(r As Range)
    Dim t As String: t = Trim(r.Text)
    If Left(t, 1) = "#" Then
        If Left(t, 3) = "###" Then r.Style = wdStyleHeading3: r.Start = r.Start + 4
        If Left(t, 2) = "##" Then r.Style = wdStyleHeading2: r.Start = r.Start + 3
        If Left(t, 1) = "#" Then r.Style = wdStyleHeading1: r.Start = r.Start + 2
    ElseIf Left(t, 1) = ">" Then
        r.Style = wdStyleQuote: r.Start = r.Start + 2
    End If
End Sub

לא בטוח שזה טוב תבדוק ותעדכן