Από Word σε vB code / BBCode

nickel

nickel

Administrator
Staff member
Αν χρησιμοποιείτε τα εικονίδια πάνω από το πλαίσιο σύνταξης του κειμένου για να μορφοποιήσετε το κείμενό σας με έντονα ή/και πλάγια γράμματα, διαφορετικά χρώματα και μεγέθη κ.λπ., θα έχετε εξοικειωθεί με τα σύμβολα που χρησιμοποιεί ο κώδικας του vBulletin (του προγράμματος υποστήριξης του φόρουμ) για να πετυχαίνει αυτές τις αλλαγές. Μοιάζουν με τα σύμβολα της HTML (της βασικής γλώσσας που χρησιμοποιείται για τις σελίδες του Ιστού), αλλά μπαίνουν σε τετράγωνες αγκύλες [ ] και όχι σε γωνιώδεις. Π.χ. επιλέγετε το τμήμα του κειμένου που θέλετε να εμφανίζεται με πιο έντονα γράμματα, πατάτε το κουμπάκι αριστερά με το Β και το πρόγραμμα βάζει b σε αγκύλες στην αρχή και /b σε αγκύλες στο τέλος αυτού του τμήματος.

Συχνά χρειάζεται να αντιγράψω ένα κείμενο από το Word στο φόρουμ, οπότε πρέπει να μετατρέψω τα πλάγια και τα έντονα σε κώδικα του vBulletin με τα b και τα i σε τετράγωνες αγκύλες. Αν είναι πολλές οι αλλαγές, ένας μάλλον κοπιαστικός τρόπος να γίνει αυτό είναι ο εξής (τον περιγράφω αναλυτικά γιατί δεν έχω βρει πιο γρήγορο):

1. Αποθήκευση του κειμένου σε μορφή λιτού ("φιλτραρισμένου") HTML (Web page, filtered).
2. Άνοιγμα του αρχείου HTML σε ιστοπλοϊκό πρόγραμμα (μπράουζερ).
3. Εμφάνιση του κώδικα στην επιλογή View > Page Source.
4. Αντιγραφή αυτού του κώδικα σε νέα σελίδα Word.
5. Καθάρισμα. Αφαίρεση όλων των άσχετων κωδικών εκτός από έντονα και πλάγια.
6. Μετατροπή γωνιωδών αγκυλών σε τετράγωνες.
7. Αντιγραφή και επικόλληση στο πλαίσιο του φόρουμ.
8. Πρόσθετο φορμάρισμα (π.χ. χρώματα).

Αν το κείμενο είναι περίπλοκο, οι αλλαγές αυτές είναι χρονοβόρες. Οπότε:
(α) Μου ανοίγετε τα μάτια διότι ήδη υπάρχει πρόγραμμα ή διαδικασία που κάνει όλα τα παραπάνω με πολύ λιγότερη βαβούρα.
(β) Επενδύω ελάχιστο χρόνο (το έχω ήδη έτοιμο για παραπλήσια δουλειά) και γράφω ένα προγραμματάκι που κάνει τη δουλειά αυτόματα.

Κάποια βοήθεια ως προς το (α) προτού περάσω στο (β);
 
Zazula

Zazula

Administrator
Staff member
drsiebenmal

drsiebenmal

HandyMod
Staff member
Αλλιώς, αν αποφασίσεις τελικά να επεκτείνεις κάποια μακροεντολή στο Word (υποθέτω ότι αυτό εννοείς «πρόγραμμα» γιατί αν έχεις αυτόνομο πρόγραμμα είναι ίσως η καλύτερη λύση), μπορεί να γίνει σχεδόν σαν ψευτοδιασύνδεση σε συνδυασμό με τις λίστες των κωδικών που δίνει ο Ζαζ και μια καλομελετημένη γραμμή εργαλείων...
 
nickel

nickel

Administrator
Staff member
Code: 
    'Word2BBCode-Converter v0.1, June 2, 2006
    'Matthew Kruer
    'Some parts adapted from
    'Word2Wiki-Converter V0.4, May 28, 2006
    'http://de.wikipedia.org/wiki/Wikipedia:Helferlein/Word2MediaWikiPlus
    'Original Version by InfPro: http://www.infpro.com/downloads/downloads/wordmedia.htm
    'Major improvements by Gunter Schmidt, Mail me: [email protected]
    'Works only with Word 2000 and above
    'License: GPL: Feel free to use and modify. Keep the credits and do not sell.

    Sub Word2BBCode()
       
        Application.ScreenUpdating = False
           
        ConvertItalic
        ConvertBold
        ConvertUnderline
        ConvertSize
        ConvertLists
        ConvertHyperlinks
       
        ActiveDocument.Content.Copy
       
        Application.ScreenUpdating = True
    End Sub
    Private Sub ConvertBold()
        ActiveDocument.Select
       
        With Selection.Find
       
            .ClearFormatting
            .Font.Bold = True
            .Text = ""
           
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
           
            .Forward = True
            .Wrap = wdFindContinue
           
            Do While .Execute
                With Selection
                    If InStr(1, .Text, vbCr) Then
                        ' Just process the chunk before any newline characters
                        ' We'll pick-up the rest with the next search
                              .Font.Bold = False
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
                                           
                    ' Don't bother to markup newline characters (prevents a loop, as well)
                    If Not .Text = vbCr Then
                        .InsertBefore "[b]"
                        .InsertAfter "[/b]"
                    End If
                   
                    .Font.Bold = False
                End With
            Loop
        End With
    End Sub
    Private Sub ConvertItalic()
        ActiveDocument.Select
       
        With Selection.Find
       
            .ClearFormatting
            .Font.Italic = True
            .Text = ""
           
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
           
            .Forward = True
            .Wrap = wdFindContinue
           
            Do While .Execute
                With Selection
                    If InStr(1, .Text, vbCr) Then
                        ' Just process the chunk before any newline characters
                        ' We'll pick-up the rest with the next search
                        .Font.Italic = False
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
                                           
                    ' Don't bother to markup newline characters (prevents a loop, as well)
                    If Not .Text = vbCr Then
                        .InsertBefore "[i]"
                        .InsertAfter "[/i]"
                    End If
                   
                    .Font.Italic = False
                End With
            Loop
        End With
    End Sub
    Private Sub ConvertUnderline()
        ActiveDocument.Select
       
        With Selection.Find
       
            .ClearFormatting
            .Font.Underline = True
            .Text = ""
           
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
           
            .Forward = True
            .Wrap = wdFindContinue
           
            Do While .Execute
                With Selection
                    If InStr(1, .Text, vbCr) Then
                        ' Just process the chunk before any newline characters
                        ' We'll pick-up the rest with the next search
                        .Font.Underline = False
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
                                           
                    ' Don't bother to markup newline characters (prevents a loop, as well)
                    If Not .Text = vbCr Then
                        .InsertBefore "[u]"
                        .InsertAfter "[/u]"
                    End If
                   
                    .Font.Underline = False
                End With
            Loop
        End With
    End Sub


    Private Sub ConvertSize()
       
    Dim fSize&
       
        If convertFontSize = False Then Exit Sub
       
        If DefaultFontSize = 12 Then DefaultFontSize = 12
        fSize = 12
           
        For fSize = 1 To 50
        If fSize > DefaultFontSize + 1 Or fSize < DefaultFontSize - 1 Then 'at least two points difference
            ActiveDocument.Select
            With Selection.Find
       
                .ClearFormatting
                .Font.Size = fSize
                .Text = ""
                .Format = True
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                .Forward = True
                .Wrap = wdFindContinue
       
                Do While .Execute
                    With Selection
       
                        If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
                            ' Just process the chunk before any newline characters
                            ' We'll pick-up the rest with the next search
                            .Collapse
                            .MoveEndUntil vbCr
                        End If
       
                        ' Don't bother to markup newline characters (prevents a loop, as well)
                        If Not .Text = vbCr Then
                            If fSize = DefaultFontSize Then
                                .InsertBefore "[size=" & fSize & "]"
                                .InsertAfter "[/size]"
                             End If
                        End If
       
                        If useDefaultStyle Then .Style = ActiveDocument.Styles(DefaultStyleName) 'must be localized to your language, see CONST on top
                        .Font.Size = DefaultFontSize
                        '.Collapse wdCollapseEnd
                        '.MoveLeft , 4, True
                        'ClearFormatting
       
                    End With
                Loop
            End With
        End If
        Next

    End Sub
    Private Sub ConvertLists()
       Dim para As Paragraph
        For Each para In ActiveDocument.ListParagraphs
            With para.Range
                .InsertBefore "[List]"
                For i = 1 To .ListFormat.ListLevelNumber
                    If .ListFormat.ListType = wdListBullet Then
                        .InsertBefore "[*]"
                    Else
                        .InsertBefore "[#]"
                    End If
                Next i
                .InsertBefore "[List]"
                .ListFormat.RemoveNumbers
               
            End With
        Next para
    End Sub
    Private Sub ConvertHyperlinks()
        'converts Hyperlinks
        '24-MAY-2006: only convert http..., mark others with error marker

    Dim hyperCount&
        Dim i&
        Dim addr$ ', title$

        hyperCount = ActiveDocument.Hyperlinks.Count

        For i = 1 To hyperCount

            With ActiveDocument.Hyperlinks(1) 'must be 1, since the delete changes count and position

                addr = .Address
                If Trim$(addr) = "" Then addr = "no hyperlink found"
                'title = .Range.Text
               
                'http, ftp
                If LCase(Left$(addr, 4)) = "http" Or LCase(Left$(addr, 3)) = "ftp" Then
                    .Delete 'hyperlink
                    .Range.InsertBefore "[url=" & addr & "]"
                    .Range.InsertAfter "[/url]"
                   
                    GoTo ConvertHyperlinks_Next
                End If
               
                'mailto:
                If LCase(Left$(addr, 7)) = "mailto:" Then
                    .Delete 'hyperlink
                    .Range.InsertBefore "[email]" & addr & " "
                    .Range.InsertAfter "[/email]"
                   
                    GoTo ConvertHyperlinks_Next
                End If
               
                'file guess
                If Len(addr) > 4 Then 'the reason for not nice goto
                    If Mid$(addr, Len(addr) - 3, 1) = "." Then
                        .Delete
                        .Range.InsertBefore "[file://" & Replace(addr, " ", "_") & " "
                        .Range.InsertAfter "]"
                       
                        GoTo ConvertHyperlinks_Next
                    End If
                End If
               
                'unidentified
                .Delete
                .Range.InsertBefore UnableToConvertMarker & "[" & addr & " "
                .Range.InsertAfter "]"

    ConvertHyperlinks_Next:
            End With

        Next i

    End Sub
 
nickel

nickel

Administrator
Staff member
Αφαίρεσα το ConvertColor και δουλεύει μια χαρά. Το προσθέτουμε στις μακροεντολές του Word με:
Alt-F8
Macro name: Word2BBCode (συμπληρώστε)
Create (πατήστε κουμπί)
Αντιγράψτε τον παραπάνω κώδικα από το Sub... ως το End Sub
Save

Για να μετατρέψετε κείμενο του Word σε κείμενο για το φόρουμ:
Επιλέγετε το κείμενο, πατάτε Alt-F8, βρίσκετε την εντολή (Word2BBCode ή όπως αλλιώς την ονομάσατε) και πατάτε Run. Οι έμπειροι μπορούν να την περάσουν και σε συνδυασμό πλήκτρων.

Καλή τύχη.
 
daeman

daeman

Administrator
Staff member
Για τους μη έμπειρους που θέλουν να προσθέσουν συνδυασμό πλήκτρων ή νέο κουμπί σε γραμμή εργαλείων, τα οποία θα εκτελούν οποιαδήποτε μακροεντολή:

Για να δημιουργήσω κουμπί, από το μενού Εργαλεία->Προσαρμογή, στην καρτέλα Εντολές πάω στην κατηγορία Μακροεντολές, επιλέγω από τη δεξιά λίστα τη μακροεντολή που θέλω και τη σύρω πάνω σε υπάρχουσα γραμμή εργαλείων.
Αν θέλω συνδυασμό πλήκτρων, πατάω το κουμπί Πληκτρολόγιο στο κάτω μέρος του παραθύρου διαλόγου Προσαρμογή, επιλέγω την κατηγορία Μακροεντολές και από τη δεξιά λίστα τη μακροεντολή που θέλω, και στο πλαίσιο Νέο πλήκτρο συντόμευσης κάτω δεξιά πατάω τον συνδυασμό πλήκτρων που θέλω να αντιστοιχίσω στη μακροεντολή μου (π.χ. Control+2). Αν υπάρχει ήδη άλλη εντολή αντιστοιχισμένη σε αυτόν τον συνδυασμό πλήκτρων, βλέπω από κάτω σε ποια εντολή είναι αντιστοιχισμένο και πράττω ανάλογα (επανακαθορίζω την αντιστοίχιση ή επιλέγω άλλο συνδυασμό πλήκτρων).

Δυστυχώς, χτύπησε κουδούνι... Στο επόμενο, θα μάθουμε πώς να μετονομάζουμε ή να μορφοποιούμε το κουμπί που μόλις προσθέσαμε. :p
 
You must log in or register to reply here.
Top