Kasta om bokstäver

När jag läste det här, så tänkte jag förstås: ”Det måste jag skriva ett Word-makro för!”. Följande kod funkar i min dator och jag ger ingen support om det inte funkar hos dig. Koden ska kasta om tecknen i alla ord i ett Word-dokument utom första och sista tecknet i ordet. Öppna Visual Basic-editorn och klistra in koden, gå sedan till dokumentet och kör makrot smulpa. Voila!

Sub smulpa()
Dim matris() As Variant
Dim myrange As Range
Dim antal As Integer, i As Integer, n As Integer
Dim j As Integer, ix As Integer, jx As Integer
Dim w1 As String, w2 As String, w3 As String
Dim w2_ As String, swapvalue0 As String, swapvalue1 As Variant
Dim endstr As String
Dim p As Integer

Set myrange = ActiveDocument.Content
antal = myrange.Words.Count

For i = 1 To antal
n = Len(myrange.Words(i))
If Right(myrange.Words(i), 1) = " " Then
n = n - 1
endstr = " "
Else
endstr = ""
End If
If n < 4 Then
myrange.Words(i) = myrange.Words(i)
Else
w1 = Left(myrange.Words(i), 1)
w2 = Mid(myrange.Words(i), 2, n - 2)
w3 = Mid(myrange.Words(i), n, 1)
ReDim matris(Len(w2) - 1, 1)
w2_ = w2
p = 0

Do Until w2 <> w2_
p = p + 1
If p = 10 Then Exit Do

    For j = 0 To Len(w2) - 1
        matris(j, 0) = Mid(w2, j + 1, 1)
        matris(j, 1) = Rnd()
    Next
        For ix = LBound(matris, 1) To UBound(matris, 1) - 1
            For jx = ix + 1 To UBound(matris, 1)
            If matris(ix, 1) > matris(jx, 1) Then
            swapvalue1 = matris(ix, 1)
            swapvalue0 = matris(ix, 0)
            matris(ix, 1) = matris(jx, 1)
            matris(ix, 0) = matris(jx, 0)
            matris(jx, 1) = swapvalue1
            matris(jx, 0) = swapvalue0
            End If
            Next
        Next
        w2_ = ""
    For j = 0 To Len(w2) - 1
        w2_ = w2_ & matris(j, 0)
    Next
   
Loop
   
   
myrange.Words(i) = w1 & w2_ & w3 & endstr
End If

Next

End Sub
Bookmark and Share