移動形狀作爲用戶滾動向右在Excel（VBA）

Question

我有一個Excel工作簿Sheet 1上兩個形狀類似下面

我的要求，當用戶朝向片的右側即朝向headers24，header25導航被等等，我希望工作表上的兩個形狀向用戶的右側移動。

是否有人請爲此提出任何建議。

感謝

Answer 1

試試這個..是的，它很容易..

將工作表模塊：其中形狀存在於這個代碼。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

    With ActiveSheet.Shapes(1) 

     .Left = ActiveWindow.VisibleRange(2, 2).Left 
     .Top = ActiveWindow.VisibleRange(2, 2).Top 

    End With 

End Sub 

座標（2，2）是您希望在隨鍵盤一起滾動時將形狀固定在的位置。

但是，如果在一個巨大的工作表上沒有滾動條的話，這會很麻煩。所以或者我認爲你可以使用刷新準時，將此代碼放在一個模塊

Private eTime 
Sub ScreenRefresh() 
    With ThisWorkbook.Worksheets("Sheet1").Shapes(1) 
     .Left = ThisWorkbook.Windows(1).VisibleRange(2, 2).Left 
     .Top = ThisWorkbook.Windows(1).VisibleRange(2, 2).Top 
    End With 
End Sub 

Sub StartTimedRefresh() 
    Call ScreenRefresh 
    eTime = Now + TimeValue("00:00:01") 
    Application.OnTime eTime, "StartTimedRefresh" 
End Sub 

Sub StopTimer() 
    Application.OnTime eTime, "StartTimedRefresh", , False 
End Sub 

而且在Sheet1（其中形狀中）下面的代碼

Private Sub Worksheet_Activate() 
    Call StartTimedRefresh 
End Sub 

Private Sub Worksheet_Deactivate() 
    Call StopTimer 
End Sub 

Answer 2

首先創建形狀：

Sub Creator() 
    Dim shp As Shape 

    Set shp = ActiveSheet.Shapes.AddShape(1, 100, 10, 60, 60) 
    shp.TextFrame.Characters.Text = "I will follow" 
    shp.Name = "MyButton" 
End Sub 

然後在工作表的代碼區：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Dim sh As Shape, r As Range 
    Set sh = ActiveSheet.Shapes("MyButton") 
    Set r = ActiveCell 
    sh.Top = r.Offset(-1, -2).Top 
    sh.Left = r.Offset(-1, -2).Left 
End Sub 

如果您前後移動活動單元格，該框將隨之移動。

注：

這只是演示代碼。您仍然需要：

• 增加保護，防止試圖移動形狀「關閉屏幕」
• 基於形狀的大小設置從ActiveCell適當的偏移