删除excel diagramm中的外部链接

Question

我已将整张表格从一个Excel文档复制到另一个。 该表中的图表也被复制了。

然而，diagramm中的数据是指另一个excel文档，而不是当前工作表。

这意味着该链接看起来像

'C:\LokaleBilder\[P3-20x]Tabelle1'!$B$3:$B$403

而不是

'20x-(Kreuz)'!$B$3:$B$403

请注意，工作表名称也已更改。

如果可以使用某些vba代码修复此问题，我想知道如何。

编辑：

请注意，这些不是超链接，其链接是文档。

我尝试通过删除文档字符串来处理它。但是失败了：

Dim currSheet As String
currSheet = ActiveSheet.Name

ActiveSheet.ChartObjects("Diagramm 1").Activate

Dim xSer As Series
Dim xvalueStr As String
Dim valueStr As String
Dim m As Integer
For m = 1 To ActiveChart.SeriesCollection.Count
    xvalueStr = ActiveChart.SeriesCollection(m).XValues

带

  

数据类型不匹配

在最后一行

EDIT2： 我可以发现xvalues的数据类型为Range。但是，我无法找到如何修改此Range数据类型。

Answer 1

我已经快速尝试重现（我认为）你正在做的事情。

我认为您选择了整张纸，复制然后将该批次粘贴到第二个工作簿的单元格A1中。在我的测试中，它复制了数据和图表，但图表仍然与源工作簿中的数据相关联。

如果您确实要将整个工作表复制到另一个工作簿并保持任何图表链接到复制的数据而不是源，我认为使用移动或复制功能可以让您实现此目的。

右键单击工作表的选项卡，然后选择移动或复制。在出现的对话框中，在下拉框中选择您的第二个工作簿，使用列表框选择工作表所在的位置，然后选中“创建复制”框。

如果这确实解决了您的问题，并且您需要定期重复该过程，则可以使用宏录制器自动执行该过程。您可能需要稍微修改宏，但它应该显示如何以编程方式实现您的副本。

Answer 2

我用值.Formula

解决了问题

Option Explicit

Sub MainRemoveDocumentLinks()

ActiveSheet.ChartObjects("Diagramm 1").Activate

Dim xSer As Series
Dim valueStr As String
Dim m As Integer
For m = 1 To ActiveChart.SeriesCollection.Count
    valueStr = ActiveChart.SeriesCollection(m).Formula
    ActiveChart.SeriesCollection(m).Formula = replaceSeriesLink(valueStr)
    Debug.Print ActiveChart.SeriesCollection(m).Formula
Next

End Sub

Function replaceSeriesLink(inputStr As String) As String

Dim currSheet As String
currSheet = ActiveSheet.Name

Dim pos As Integer
Dim pos_old As Integer

pos = 1
pos_old = 0

Dim pos_start As Integer
Dim pos_end As Integer

pos_start = 0
pos_end = 0

Do While pos > 0
    pos = InStr(pos + 1, inputStr, "'")
    If pos_old = pos Then
        Exit Do
    End If
    If pos_start = 0 Then
        pos_start = pos
    Else
        pos_end = pos
        Dim DatalinkToReplace As String
        DatalinkToReplace = Mid(inputStr, pos_start + 1, pos_end - pos_start - 1)
        inputStr = Replace(inputStr, DatalinkToReplace, currSheet)
        Debug.Print inputStr
        pos_start = 0
    End If

    pos_old = pos
Loop

replaceSeriesLink = inputStr

End Function