1、建立带索引列的空表格。注意此表中的索引列单元格内容名称是用于VBA查找对应名称的图表的。
2、建立一个名为"Chart"的图表页用于存放所有需定期更新数据的图表。并按需要建立图表。且将对应的索引名称放在对应图表上方的A列内。
3、一 一选中每个图表，将图表名命名为以"Chart -"为前缀加对应索引代码。如Chart -TZ来命名体重统计表。
4、录制一个名字为setpiclinkage的空宏。并设定快捷键为Ctrl+Shift+L
5、编辑刚建立的空宏.
6、在空宏中插入如下代码。注意代码中“柱状图”及名为"Chart"的工作表单名称是以例子应吹涡皋陕用设定的，如参考此经验，请根据实际需要重命名并更改代码中的名称。Dim a As StringDim b As StringDim c As StringDim d As StringDim e As IntegerDim i As IntegerDim j As IntegerDim shname As Stringshname = ActiveSheet.NameMsgBox "请确认是否想把图片库图片拷入:" & shnameSheets(shname).Selecti = 1j = Application.WorksheetFunction.CountA(Range("A:A"))d = ActiveSheet.Range("2:2").Find("柱状图").Column - 1 For i = 3 To j Sheets(shname).Select c = Range("A" & i).Value Sheets("Chart").Select On Error GoTo errskip e = ActiveSheet.Range("A:A").Find(c).Row If c <> "" Then Sheets("Chart").Select On Error GoTo errskip ActiveSheet.ChartObjects("Chart -" & c).Activate Selection.Copy Sheets(shname).Select Range("A" & i).Offset(0, d).Select ActiveSheet.Pictures.Paste.Select a = Range("A" & i).Offset(0, d).Width / Selection.Width b = Range("A" & i).Offset(0, d).Height / Selection.Height If a <= b Then Selection.ShapeRange.ScaleWidth a, msoFalse, msoScaleFromTopLeft Else Selection.ShapeRange.ScaleHeight b, msoTrue, msoScaleFromTopLeft End If Sheets("Chart").Select On Error GoTo errskip e = ActiveSheet.Range("A:A").Find(c).Row Sheets(shname).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:="'" & Worksheets("Chart").Name & "'" & "!A" & e Sheets("Chart").Select ActiveSheet.ChartObjects("Chart -" & c).Activate ActiveChart.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="", SubAddress:="'" & Sheets(shname).Name & "'" & "!" & Chr(d + 65) & i Sheets("Chart").Selecterrskip: Sheets(shname).Select Else End If Next i拷贝完后保存退出。
7、好，一切以就绪。回到linkage页按快捷键Ctrl+Shift+L。运行完后图表以图片的形式被拷贝进表内，对应的超链接也建立完成
