[發問] 關於讓儲存格對應核取方塊 勾選 與 未勾選

starry1314

想請問以下附件是可打勾方塊,請問要怎麼例如讓
1.打勾的時候 A1=審核通過  
2.未打勾的時候A1=尚未審核呢

核取方塊 打勾-2.zip (22 Bytes)

下載次數: 4

2015-5-1 16:32

GBKEE

回復 3# starry1314

附檔是文字方塊(圖1),不是核取方塊(圖2)

    圖1

下載 (76.98 KB)

2015-5-3 11:19

圖2

下載 (65.61 KB)

2015-5-3 11:20

如圖3 可用=IF(A1=TRUE,"審核通過","尚未審核")

圖3

下載 (119.83 KB)

2015-5-3 11:21

starry1314

回復 2# starry1314

目前以IF替代

不知可否簡化為從上頁指令就內建完成
核取方塊 打勾-IF替代.zip (15.87 KB)

下載次數: 6

2015-5-1 16:50

下載 (10.81 KB)

2015-5-1 16:51

starry1314

像GBKEE版主的指令,指定位置知道在哪邊修改,但要如何改成我所需要的字體呢?

1. Option Explicit
   
2. Dim AR(1 To 2), Sh As Worksheet   '模組 私用變數
   
3. Sub AUTO_OPEN()                   '檔案開啟時一般模組 自動執行的檔案
   
4.     Dim S As Shape, A(), B(), i As Integer
   
5.     Set Sh = Sheets("工作表1")
   
6.     For Each S In Sh.Shapes
   
7.         If S.Type = msoTextBox Then             '方塊的Type   msoTextBox 值= 17
   
8.             S.OnAction = "check"                '指定巨集
   
9.             ReDim Preserve A(i)
   
10.             ReDim Preserve B(i)
    
11.             A(i) = S.Name                       '方塊名稱
    
12.             If i = 0 Then
    
13.                Set B(i) = Sh.[d5]               '指定儲存格
    
14.             Else
    
15.                 Set B(i) = B(i - 1).Offset(1)   '指定儲存格
    
16.             End If
    
17.             i = i + 1
    
18.         End If
    
19.     Next
    
20.     AR(1) = A                                   '指定陣列內容
    
21.     AR(2) = B                                   '指定陣列內容
    
22. End Sub
    
23. Sub check()  '必須是按下方塊執行此程序
    
24.     'AUTO_OPEN   '如有錯誤 執行 AUTO_OPEN 一次
    
25.     Dim K As String, M As Boolean, i As Integer
    
26.     With Sh.Shapes(Application.Caller)
    
27.         With .TextFrame
    
28.             K = .Characters.Text
    
29.             If Left(K, 1) = "n" Then
    
30.                 .Characters.Text = "o 未選取"
    
31.                 M = False
    
32.             Else
    
33.                 .Characters.Text = "n 選取"
    
34.                 M = True
    
35.             End If
    
36.             .Characters(1, Len(K) + 1).Font.Size = 10
    
37.             .Characters(1, 1).Font.Size = 18
    
38.         End With
    
39.         i = Application.Match(.Name, AR(1), 0) - 1      '取的方塊名稱在AR(1)的索引值
    
40.         AR(2)(i).Value = M
    
41.         AR(2)(i).Offset(, 1).Value = IIf(CSng(M) = 0, 0, 1)
    
42.     End With
    
43. End Sub

複製代碼