Excel内批量处理图片链接跳转
1、建立带索引列的空表格。注意此表中的索引列单元格内容名称是用于VBA查找对应名称的图表的。
2、建立一个名为"Chart"的图表页用于存放所有需定期更新数据的图表。
并按需要建立图表。且将对应的索引名称放在对应图表上方的A列内。
3、一 一选中每个图表，将图表名命名为以"Chart -"为前缀加对应索引代码。如Chart -TZ来命名体重统计表。
4、录制一个名字为setpiclinkage的空宏。并设定快捷键为Ctrl+Shift+L
5、编辑刚建立的空宏.
6、在空宏中插入如下代码。
注意代码中“柱状图”及名为"Chart"的工作表单名称是以例子应用设定的，如参考此经验，请根据实际需要重命名并更改代码中的名称。
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As Integer
Dim i As Integer
Dim j As Integer
Dim shname As String
shname = ActiveSheet.Name
MsgBox "请确认是否想把图片库图片拷入:" & shname
Sheets(shname).Select
i = 1
j = 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").Select
errskip:
Sheets(shname).Select
Else
End If
Next i
拷贝完后保存退出。
7、好，一切以就绪。回到linkage页按快捷键Ctrl+Shift+L。运行完后图表以图片的形式被拷贝进表内，对应的超链接也建立完成
