怎樣把文本框的編號自動遞增？還有字體變大變紅色？用VBA寫代碼執行也不對-有解無憂

如題：怎樣把文本框的編號自動遞增？還有字體變大變紅色？用VBA寫代碼執行也不對

代碼如下：要怎樣修改代碼？

uj5u.com熱心網友回復：

沒有你的檔案,不知道怎么調字體,只能幫你到這兒了.

Option Explicit



Sub 自動編號()

    Application.ScreenUpdating = False

    Dim shpTemp As Shape, intStart As Long

    intStart = InputBox("請輸入編號的起始數，默認為“1000000001”：", "輸入數值", "1000000001")

    For Each shpTemp In ThisDocument.Shapes

        shpTemp.TextFrame.TextRange.Paragraphs(2).Range = "存根：NO   " & intStart

        intStart = intStart + 1

    Next

    Application.ScreenUpdating = True

End Sub

uj5u.com熱心網友回復：

改了一下,增加字體顏色和大小,你可以手動修改字體大小(Font.Size):

Option Explicit



Sub 自動編號()

    Application.ScreenUpdating = False

    Dim shpTemp As Shape, intStart As Long

    intStart = InputBox("請輸入編號的起始數，默認為“1000000001”：", "輸入數值", "1000000001")

    For Each shpTemp In ThisDocument.Shapes

        With shpTemp.TextFrame.TextRange.Paragraphs(2).Range

            .Text = "存根：NO   " & intStart

            .Bold = True

            .Font.Color = wdColorRed

            .Font.Size = 15

        End With

        intStart = intStart + 1

    Next

    Application.ScreenUpdating = True

End Sub

uj5u.com熱心網友回復：

參考 2 樓 milaoshu1020 的回復:

改了一下,增加字體顏色和大小,你可以手動修改字體大小(Font.Size):

Option Explicit



Sub 自動編號()

    Application.ScreenUpdating = False

    Dim shpTemp As Shape, intStart As Long

    intStart = InputBox("請輸入編號的起始數，默認為“1000000001”：", "輸入數值", "1000000001")

    For Each shpTemp In ThisDocument.Shapes

        With shpTemp.TextFrame.TextRange.Paragraphs(2).Range

            .Text = "存根：NO   " & intStart

            .Bold = True

            .Font.Color = wdColorRed

            .Font.Size = 15

        End With

        intStart = intStart + 1

    Next

    Application.ScreenUpdating = True

End Sub

首先，非常感謝你的解答。我上傳不了檔案。我是按著你的代碼寫進去執行，得出的結果不理想：
1.文字沒有對齊，下行也沒有自動回車換行。
2.文本框里的編碼不對：我的要求是同行的文本框編號是一樣，到下個行的文本框遞增+1
3..執行代碼后只顯示4行的文本框的編碼自動遞增而已，本頁有9個文本框，意思是后面的沒有自動編碼。

我想要的結果如下：

uj5u.com熱心網友回復：

Quote: 參考 2 樓 milaoshu1020 的回復:

改了一下,增加字體顏色和大小,你可以手動修改字體大小(Font.Size):

Option Explicit



Sub 自動編號()

    Application.ScreenUpdating = False

    Dim shpTemp As Shape, intStart As Long

    intStart = InputBox("請輸入編號的起始數，默認為“1000000001”：", "輸入數值", "1000000001")

    For Each shpTemp In ThisDocument.Shapes

        With shpTemp.TextFrame.TextRange.Paragraphs(2).Range

            .Text = "存根：NO   " & intStart

            .Bold = True

            .Font.Color = wdColorRed

            .Font.Size = 15

        End With

        intStart = intStart + 1

    Next

    Application.ScreenUpdating = True

End Sub

[/quot/]

我word檔案的文本框是插入2個文本框并列一行，意思是：word檔案里共有9行，18個文本框。并還有另外9個小文本框，即“加蓋印章”

請問老師，我可以加你QQ郵箱發源檔案嗎？我的郵箱是[email protected]

uj5u.com熱心網友回復：

我的郵箱是: [email protected] .

這個是每兩個(一行)加一次,增加了回車換行的代碼:



Option Explicit

 

Sub 自動編號()

    Application.ScreenUpdating = False

    Dim shpTemp As Shape, intStart As Long

    intStart = InputBox("請輸入編號的起始數，默認為“1000000001”：", "輸入數值", "1000000001")

    Dim i As Integer

    i = 0



    For Each shpTemp In ThisDocument.Shapes

        With shpTemp.TextFrame.TextRange.Paragraphs(2).Range

            .Text = "存根：NO   " & intStart & vbCrLf

            .Bold = True

            .Font.Color = wdColorRed

            .Font.Size = 15

        End With

        i = i + 1

        If i Mod 2 = 0 Then

            intStart = intStart + 1

        End If

    Next

    Application.ScreenUpdating = True

End Sub

至于后邊的沒有,只能說后邊的和前邊的不一樣,沒有相應的Range吧.

轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/38704.html

標籤：VBA

上一篇：VB 關于類中宣告全域結構體變數的問題

下一篇：VB怎么截取兩個不同字串中的內容