[發問] 如何讓篩選不會讓按鈕CommandButton位置跑掉?

av8d

小廳單雙主位桌牌.rar (20.6 KB)

下載次數: 14

2013-5-9 14:29

如何將儲存格對應到圖形?

以上再次麻煩各位大大了~

av8d

回復 1# av8d


    剛使用錄製巨集~有了一點眉目~

1. Sub aa()
   
2.     ActiveSheet.Shapes.Range(Array("Oval 30")).Select
   
3.     Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = 工作表1.[B6]
   
4. End Sub

複製代碼

但是希望能縮短成一行~再次感謝

av8d

回復 2# av8d


    一行也解決了~

1. Sub aa()
   
2.     Sheets("工作表2").Select
   
3.     ActiveSheet.Shapes.Range(Array("Text Box 1")).TextFrame2.TextRange.Characters.Text = 工作表1.[B6]
   
4.    
   
5.     ActiveSheet.Shapes.Range(Array("Oval 30")).TextFrame2.TextRange.Characters.Text = 工作表1.[B7]
   
6.    
   
7.     ActiveSheet.Shapes.Range(Array("Oval 31")).TextFrame2.TextRange.Characters.Text = 工作表1.[B8]
   
8. End Sub

複製代碼

再次感謝各位大大的觀看~

GBKEE

回復 1# av8d
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, Sh_Name As String, i As Integer
   
4.     Set Rng = Sheets("首頁").[B5]
   
5.     Do While Rng <> ""
   
6.          Sheets(Rng.Offset(-2) & "人").Copy , Sheets(Sheets.Count) '複製 12人,15人工作表
   
7.          '***** 原檔案的工作表 "12-1" 改為 "12人","12-2" 改為 "15人"  *********
   
8.          'Sh_Name = Mid(Rng, 1, InStr(Rng, vbLf))                  '複製的工作表名稱
   
9.          With ActiveSheet
   
10.             '.Name = Sh_Name
    
11.             .Shapes("Text Box 1").OLEFormat.Object.Characters.Text = Rng
    
12.             For i = 1 To Rng.Offset(-2)
    
13.                '**** 須依序修改 12人,15人 座位圖的名稱 P:1-> P:12, P:15  ****
    
14.                 With .Shapes("P:" & i).OLEFormat.Object
    
15.                     .Characters.Text = Rng.Offset(i)
    
16.                     .AutoSize = IIf(Len(Rng.Offset(i)) > 0, True, False)    '圖片:能自動調整大小
    
17.                     If InStr(Rng.Offset(-1), "雙") And i <= 2 Or i = 1 Then '主位圖
    
18.                         .ShapeRange.Fill.ForeColor.SchemeColor = 14
    
19.                     End If
    
20.                      With .Characters.Font
    
21.                         .Name = "新細明體"
    
22.                         .FontStyle = "粗體"
    
23.                         .Size = 16
    
24.                     End With
    
25.                 End With
    
26.             Next
    
27.         End With
    
28.         Set Rng = Rng.Offset(, 1)
    
29.     Loop
    
30. End Sub

複製代碼

av8d

小廳單雙主位俯視圖.rar (87.53 KB)

下載次數: 11

2013-5-13 11:37

以上是暫時修改的

但是當數量一多~可能就會很複雜~
當時原本使用隱藏欄位的方式~但是發現~
當展開的時候~按鈕全部會擠成一團~
不知道是否有不會跑位的方法呢?

GBKEE

回復 5# av8d
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim E As Shape, Msg As Boolean
   
4.     With ActiveSheet
   
5.         .Range("B:C").EntireColumn.Hidden = True   '測試 B:C欄 隱藏
   
6.         For Each E In .Shapes                   '
   
7.             Msg = E.OLEFormat.Object.TopLeftCell.EntireColumn.Hidden
   
8.             'TopLeftCell: 圖片所在的儲存格位置
   
9.             'Msg = Ttue : B:C欄 隱藏 反之  Msg = False
   
10.             '*****圖片所在的欄為隱藏: 圖片隱藏 ***
    
11.             E.Visible = Not Msg  '圖片物件是否可見的值 = Not Msg 的值
    
12.             '********************************
    
13.             'Not Msg ; Msg = Ttue  -> False
    
14.             'Not Msg ; Msg = False -> Ttue
    
15.         Next
    
16.         Stop    '程式暫停.. (查看工作表圖片隱藏)    按 F5 繼續
    
17.         .Range("B:C").EntireColumn.Hidden = False   'B:C欄  取消 隱藏
    
18.         For Each E In Me.Shapes
    
19.             E.Visible = msoTrue
    
20.         Next
    
21.     End With
    
22. End Sub

複製代碼