删除excel图表中的外部链接答案

【问题标题】：remove external links in excel diagramm删除excel图表中的外部链接
【发布时间】：2013-04-15 12:28:53
【问题描述】：

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

但是图表中的数据是指另一个 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

与

数据类型不匹配

在最后一行

编辑2：我可以发现 xvalues 的数据类型为Range。但是我不知道如何修改此 Range 数据类型。

【问题讨论】：

你搜索过这里吗？很多类似的问题萌芽。 like this one , or here
你是怎么复制的？您可以使用 VBA 进行复制，一次一张，随时修复图表的链接。
@mehow，它的数据/工作簿链接而不是超链接

标签： excel vba diagram

【解决方案1】：

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

我认为您选择了整张工作表，将其复制并粘贴到第二个工作簿的单元格 A1 中。在我的测试中，它复制了数据和图表，但图表仍然链接到源工作簿中的数据。

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

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

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

【讨论】：

这可能会在未来解决它，但现在我有兴趣修复现有文件。

【解决方案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

【讨论】：