Question

当用户将鼠标悬停在迷你图表上时，我试图显示更大版本的图形和一些支持单元格。想法是复制目标单元格的图像（包括图形和支持单元格）并将图像加载到用户表单中。

当我从另一个宏调用代码时，一切都运行良好。但是，如果我从一个函数触发它，宏将返回一个空白屏幕截图，因为它无法选择要拍摄照片的单元格。我修改了函数，因此它只更新电子表格中的单元格（CY57），然后使用spreadsheet_change事件启动宏。在这种情况下，宏运行没有错误，但它仍然没有适当地选择单元格来捕获图像，因此返回一个空白图像。如果我在电子表格中手动更改目标单元格（CY57），则spreadsheet_change事件将正确运行以获取图像。

以下是一些更具体的内容：
我在单元格中使用以下公式和sparkline来调用函数：

=IFERROR(HYPERLINK(Row_Location(ROW()),""),"")

成功触发并运行此功能代码以更新单元格CY57中的值：

Public Function Row_Location(Data_Row As Integer)
    If ActiveSheet.Range("CY57") <> Data_Row Then ActiveSheet.Range("CY57") = Data_Row
End Function

然后我使用worksheet_change事件启动ExportRange宏。一切正常

Private Sub Worksheet_Change(ByVal Target As Range)

  If Not Application.Intersect(Range("CY57"), Range(Target.Address)) _
       Is Nothing Then 
       ExportRange
  End If
End Sub

问题出现在ExportRange宏中。我包含下面的代码，但我不确定你需要整个块。在没有进入所有测试的情况下，我已经将问题缩小到这样一个事实：它不允许我在由函数结果或直接从函数触发时选择或激活任何单元格。因为我不能这样做，所以它会导出一个空白图像而不是预期的单元格。

Sub ExportRange() '(rng As Range)
  Dim cob, sc

 Application.ScreenUpdating = True
 Sheets("blank").Range("CX64:Dk85").Select


 Set rng = Selection

 rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture


 Set cob = rng.Parent.ChartObjects.Add(10, 10, 200, 200)
 'remove any series which may have been auto-added...
 Set sc = cob.Chart.SeriesCollection
 Do While sc.Count > 0
     sc(1).Delete
 Loop



  With cob
    .ShapeRange.Line.Visible = msoFalse  '<<< remove chart border
    .Height = rng.Height
    .Width = rng.Width
    .Chart.Paste
    .Chart.Export Filename:=ThisWorkbook.Path & "\temp_image.jpg", Filtername:="jpg"
    .Delete
  End With

UserForm1.Show   

End Sub

如果我手动在CY57单元格中输入一个数字，那么一切运行正常。如果我从另一个宏调用ExportRange它运行正常。

Sub Tester()
  ExportRange ' ActiveSheet.Range("CX64:Dk85")
End Sub

只有当Worksheet_change事件由函数的结果触发时才会失败。

我该怎么做？

Answer 1

由于您认为问题是尝试选择单元格，您是否尝试过Set rng = Sheets("blank").Range("CX64:Dk85")而不是下面的代码？

 Sheets("blank").Range("CX64:Dk85").Select
 Set rng = Selection

Answer 2

我能够通过采取另一种方法解决问题。虽然VBA不允许我选择单元格，但它允许我选择图表对象。因此，我修改了图表对象，通过向公式驱动的图表对象添加一些文本框来显示我想要显示的信息。我还能够将图片粘贴到评论框而不是用户表单中。这为用户创造了更好的体验。

对于那些想知道的人，这是我使用的解决方案：

以下公式位于显示迷你图的单元格中。当鼠标在单元格上传递时，它会调用函数

=IFERROR(HYPERLINK(Row_Location(ROW(), ADDRESS(ROW(),COLUMN())),""),"")

该函数捕获鼠标悬停的行和单元格地址，并将其保存到电子表格中。代码保存在普通模块中。公共函数Row_Location（Data_Row As Integer，Mouse_Location As String） '当使用此功能将鼠标传递到单元格时，这将捕获单元格的行号和地址。它将其写入电子表格以供另一个宏选择。

If ActiveSheet.Range("CZ59") <> Data_Row Then

  Application.EnableEvents = False
  'this captures the cell where the mouse is currently hovering
  ActiveSheet.Range("CZ60") = Mouse_Location
  Application.EnableEvents = True

  'this captures the row where the mouse is currently hovering
  ActiveSheet.Range("CZ59") = "=" & Data_Row
End If

结束功能

从函数中将值保存到电子表格会更新电子表格中的常规图表（即普通图表对象，而不是迷你图）并触发Worksheet_Change，从而启动下面的宏。代码仅在目标单元格更改时运行。

Private Sub Worksheet_Change(ByVal Target As Range)

  If Not Application.Intersect(Range("CZ59"), Range(Target.Address)) _
   Is Nothing Then
      'This clears out any previous comments
      Range("F7:N57").ClearComments

      'This captures the image from the chart object
      Set MyChart = ActiveSheet.ChartObjects("Zoom_Chart").Chart
      Fname = ThisWorkbook.Path & "\temp_image3.jpg"
      MyChart.Export Filename:=Fname, Filtername:="JPG"

      'This picks up the previously saved location where the mouse is hovering
      Mouse_Location2 = ActiveSheet.Range("CZ60").Value

      'This creates a comment box in the cell where the mouse is hovering and adds the image to the comment box
      Set rng = ActiveSheet.Range(Mouse_Location2)
      rng.AddComment (" ")
      rng.Comment.Shape.Height = 325
      rng.Comment.Shape.Width = 650

      rng.Comment.Shape.Fill.UserPicture ThisWorkbook.Path & "\temp_image3.jpg"
  End If
End Sub

上面的代码拍摄了图表对象的图片并保存。然后，它会向鼠标悬停的单元格添加注释，并将图片导入注释框。当用户将鼠标移出单元格时，注释框会自动隐藏。每次触发代码时，它都会清除先前的注释框。

excel VBA宏在由函数

2 个答案: