2013-04-15 46 views
0

我已经将一张表格从一个excel文档复制到另一个。 该表中的图表也被复制。在excel中删除外部链接diagramm

但是,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数据类型。

+0

你搜查这里的价值问题呢?许多类似的问题萌芽。 [像这样](http://stackoverflow.com/questions/8678752/in-excel-how-can-i-programmatically-edit-the-address-in-a-range-of-cells-contai),[或这里](http://stackoverflow.com/questions/6903884/editing-hyperlinks-excel-2010-macro) – 2013-04-15 12:36:42

+0

你是怎么做的复制?您可以使用VBA进行复制,一次一张,随时修复图表的链接。 – NickSlash

+0

@mehow,它的数据/工作簿链接,而不是超链接 – NickSlash

回答

0

我已经试图重现你在做什么(我认为)。

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

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

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

move or copy

如果不解决您的问题,它的一个过程中,你需要经常重复,你可以使用宏录制器来自动执行它。您可能需要稍微修改宏,但它应该会显示如何以编程方式实现您的副本。

+0

这可能会解决它,但现在我已经在修复现有文档。 –

0

我解决了.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