简体   繁体   English

根据单元格值移动形状

[英]Move Shape based on cell value

As in 1st image are milestone which is in milestone worksheet and 2nd image is of the plan worksheet where triangle shape on the bar is to be moved with the reference Dates (C5) from milestone worksheet.如第一张图片是里程碑工作表中的里程碑,第二张图片是计划工作表,其中条形上的三角形将与里程碑工作表中的参考日期 (C5) 一起移动。 Those milestones should be properly referenced on value based on plan worksheet.这些里程碑应根据计划工作表的价值正确引用。 Eg.例如。 Milestone worksheet c5 = June 14, triangle should be placed one row above the bar in cell M12 ie June 14 in Plan worksheet.里程碑工作表 c5 = 6 月 14 日,三角形应放置在单元格 M12 中的条上方一行,即计划工作表中的 6 月 14 日。 And same has to be done to other milestones.其他里程碑也必须这样做。

I am new to VBA i tried something, but it didn't run.我是 VBA 的新手,我尝试了一些东西,但它没有运行。 i guess my cell range selection is wrong.我想我的单元格范围选择是错误的。 Code is given below:代码如下:

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

在此处输入图像描述在此处输入图像描述

Not a solution, a pointer, but wanted the formatting this had to offer.不是一个解决方案,一个指针,而是想要这个必须提供的格式。

I've had to do a bit of work to get the match function to work, you could use .find here or something similar.我必须做一些工作才能让match function 工作,你可以使用.find here 或类似的东西。 Hope this helps you or inspires you.希望这可以帮助您或启发您。

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