0

我已将整个表格从一个 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

和

数据类型不匹配

在最后一行

Edit2：我可以发现 xvalues 是 datatype Range。但是，我不知道如何修改此 Range 数据类型。

4

2 回答 2

0

I've had a quick go at trying to reproduce what (I think) you're doing.

I think you selected the whole sheet, copied and then pasted the lot into cell A1 of your second workbook. In my test it copied the data and the chart but the chart remained linked to the data in the source workbook.

If you do want to copy the entire worksheet to another workbook and keep any charts linked to the copied data and not the source, I think using the move or copy feature will let you acheive this.

Right click your worksheet's tab and select move or copy. In the dialogue that appears, select your second workbook in the dropdown box, the position you want the sheet to be in using the listbox and then check the "Create a Copy" box.

move or copy

If that does solve your issue, and its a process you need to repeat regularly, you could use the macro recorder to automate it. You might need to modify the macro slightly but it should show you how to programatically acheive your copy.

于 2013-04-15T13:20:52.197 回答
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
于 2013-04-15T15:20:32.260 回答