- 帖子
- 471
- 主題
- 121
- 精華
- 0
- 積分
- 579
- 點名
- 0
- 作業系統
- WIN10
- 軟體版本
- OFFICE2019
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-4-16
- 最後登錄
- 2023-1-17
|
2#
發表於 2015-5-1 16:45
| 只看該作者
像GBKEE版主的指令,指定位置知道在哪邊修改,但要如何改成我所需要的字體呢?- Option Explicit
- Dim AR(1 To 2), Sh As Worksheet '模組 私用變數
- Sub AUTO_OPEN() '檔案開啟時一般模組 自動執行的檔案
- Dim S As Shape, A(), B(), i As Integer
- Set Sh = Sheets("工作表1")
- For Each S In Sh.Shapes
- If S.Type = msoTextBox Then '方塊的Type msoTextBox 值= 17
- S.OnAction = "check" '指定巨集
- ReDim Preserve A(i)
- ReDim Preserve B(i)
- A(i) = S.Name '方塊名稱
- If i = 0 Then
- Set B(i) = Sh.[d5] '指定儲存格
- Else
- Set B(i) = B(i - 1).Offset(1) '指定儲存格
- End If
- i = i + 1
- End If
- Next
- AR(1) = A '指定陣列內容
- AR(2) = B '指定陣列內容
- End Sub
- Sub check() '必須是按下方塊執行此程序
- 'AUTO_OPEN '如有錯誤 執行 AUTO_OPEN 一次
- Dim K As String, M As Boolean, i As Integer
- With Sh.Shapes(Application.Caller)
- With .TextFrame
- K = .Characters.Text
- If Left(K, 1) = "n" Then
- .Characters.Text = "o 未選取"
- M = False
- Else
- .Characters.Text = "n 選取"
- M = True
- End If
- .Characters(1, Len(K) + 1).Font.Size = 10
- .Characters(1, 1).Font.Size = 18
- End With
- i = Application.Match(.Name, AR(1), 0) - 1 '取的方塊名稱在AR(1)的索引值
- AR(2)(i).Value = M
- AR(2)(i).Offset(, 1).Value = IIf(CSng(M) = 0, 0, 1)
- End With
- End Sub
|
|
發表於 2015-5-3 11:21
| 
