簡體   English   中英

根據單元格值移動形狀

[英]Move Shape based on cell value

如第一張圖片是里程碑工作表中的里程碑,第二張圖片是計划工作表,其中條形上的三角形將與里程碑工作表中的參考日期 (C5) 一起移動。 這些里程碑應根據計划工作表的價值正確引用。 例如。 里程碑工作表 c5 = 6 月 14 日,三角形應放置在單元格 M12 中的條上方一行,即計划工作表中的 6 月 14 日。 其他里程碑也必須這樣做。

我是 VBA 的新手,我嘗試了一些東西,但它沒有運行。 我想我的單元格范圍選擇是錯誤的。 代碼如下:

Sub Check()
    Dim rng As Range
    Set rng = Sheets("Gleichschenkliges Dreieck 1").Range("H$10:cm$10")
    For Each cell In rng  
    If cell.Value <> "" Then
            Set rng = Range("C13").End(xlToRight).Offset(0, 1)
            ActiveSheet.Shapes("Gleichschenkliges Dreieck 1").Left = rng.Left
    End If
    Next
End Sub

在此處輸入圖像描述在此處輸入圖像描述

不是一個解決方案,一個指針,而是想要這個必須提供的格式。

我必須做一些工作才能讓match function 工作,你可以使用.find here 或類似的東西。 希望這可以幫助您或啟發您。

Sub test_ct()

Dim r As Excel.Range
Dim r2 As Excel.Range
Dim l As Long
Dim s As Shape
Dim d As Date

d = CDate("01/05/2019")

'   Range of my dates at the top
Set r = Sheets("Sheet10").Range("c1:o1")
'   The shape i want to move
Set s = Sheets("Sheet10").Shapes("Triangle1")

'   Set default position
s.Left = 10

'   Get the column of this date, MATCH intended here, but failing on dates.
l = Application.WorksheetFunction.Match(CDbl(CDate("01/05/2019")), r, 0)

'   Destination plus 1/2 width, needs fine tuning, to find centre
l = r(1, l).Left
l = l + (r(1, l).Width / 4)

'   Move the shape
s.Left = l


End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM