繁体   English   中英

VBA 代码用于绘制具有给定起点和终点的图形

[英]VBA code for plotting graph with given starting point and ending point

请问如何创建一个VBA代码到plot一个给定起点和终点的聚集柱形图? 我使用输入框inputbox来允许用户以 state 为起点。 例如,起点是 1 月 20 日。 然后,代码需要从一组数据中找出起点的单元格名称,例如A30。 然后用户需要键入结束点以定义需要绘制的数据范围,例如,2 月 21 日,它位于单元格 A45 处。 那么图表的数据范围应该从A30:A45, B30:B45开始。

我已经尝试了所有可以在网上找到的方法,但没有任何效果。

提前致谢

请尝试下一个代码:

Sub createChartChooseSt_EndDate()
   Dim cht As Shape, sh As Worksheet, LastRA As Long, rngPlot As Range
   Dim startP, endP, cellStart As Range, cellEnd As Range
   
   Set sh = ActiveSheet 'use here the sheet you need
   
   LastRA = sh.Range("A" & sh.rows.Count).End(xlUp).row
   'use the standard date format according to your regional settings:
   startP = InputBox("Please enter the Starting poind date (Format dd/mm/yyyy)", "Choose starting date", Date)
   If Not IsDate(startP) Then MsgBox "No valid date format entered (start)...": Exit Sub
   
   endP = InputBox("Please enter the Ending poind date (Format dd/mm/yyyy)", "Choose ending date", Date + 10)
   If Not IsDate(endP) Then MsgBox "No valid date format entered (end)...": Exit Sub

   'create the range to be plotted:
   'find cellStart:
   Set cellStart = sh.Range("A1:A" & LastRA).Find(what:=CDate(startP), lookAt:=xlWhole, LookIn:=xlValues, After:=sh.Range("A1"), SearchDirection:=xlNext)
   If cellStart Is Nothing Then MsgBox "No start date found...": Exit Sub

   'find cellEnd:
   Set cellEnd = sh.Range("A1:A" & LastRA).Find(what:=CDate(endP), lookAt:=xlWhole, LookIn:=xlValues, After:=cellStart, SearchDirection:=xlNext)
   If cellEnd Is Nothing Then MsgBox "No end date found...": Exit Sub
   
   Set rngPlot = sh.Range(sh.cells(cellStart.row, 1), sh.cells(cellEnd.row, 2))
   Set cht = sh.Shapes.AddChart
    With cht.Chart
        .HasTitle = True
        .ChartTitle.Text = "My custom chart"
        .SetSourceData Source:=rngPlot
        .ChartType = xl3DBarClustered
    End With
End Sub

请在测试后发送一些反馈。

您可以为创建的图表命名,下次运行代码时,通过一些修改,它可能会检查图表是否存在,并且只更改新选择的日期开始/日期结束的数据源......

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM