Excel-双击自动引用图片(一)

发表于 更新于 分类于 ， 阅读次数：

　最近遇到一个朋友在使用Excel的时候遇到一个问题。朋友有难，岂能不帮？

需求描述

　在Excel的sheet1中有一组汇总表，其中包含了两组信息[表名、货号]。在对应表中，有详细信息[货号、型号、价格、数量]。当双击sheet1中的具体货号的单元格，将详细信息显示在sheet1中。效果图如下。
效果图.png

准备

　由于涉及到自动引用，并且在Excel中没有找到对应的函数。所以，需要自己写VBA(Visual Basic For Applications)来实现。

基础知识

　对VBA也不甚了解，所以，需要基础扫盲一下。根据上述需求，可以得知我们需要编写的功能有：双击执行事情、获取单元格值、截图功能、筛选功能等。
　VBA提供了单击执行事情(Worksheet_SelectionChange)、双击执行事件(Worksheet_BeforeDoubleClick)、单元格内容改变执行事情(Worksheet_Change)等函数。可以通过Worksheet_BeforeDoubleClick来完成双击执行事件。

1
2
3
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    MsgBox "你进行了双击！"
End Sub

　VBA定义变量是通过Dim variable As Type(String、Integer等)进行定义的。本例定义了四个变量，用来存储信息。

1
2
3
4
Dim getValue As String '单元格值
Dim getInt As Integer '第一次出现行数
Dim getInt2 As Integer '最后出现行数
Dim getNum As Integer

　VBA中的For循环，需要与Next成对出现。退出For的话用exit for
for循环.jpg

1
2
3
4
For i=1 To 10 Then
    MsgBox i
    exit for
Next

　VBA中的If语句，需要与Then、End If成对出现。

1
2
3
If i = 10 Then
    MsgBox i
End If

　VBA中的图片删除、生成等操作。这里图片生成是指对应区域单元格的链接图片。

1
2
3
4
5
6
For Each im In ActiveSheet.Shapes
    ActiveSheet.Shapes.Delete
Next
Sheet2.Range("A1:D1").Copy
ActiveSheet.Pictures.Paste(Link:=True).Select
Application.CutCopyMode = False

　VBA中获取单元格信息，用target即可。

1
2
3
Target.Address `目标但单元格的地址
Target.Column `目标单元格的列
Range(Target.Address) `目标单元格的值

　VBA中的运算符号，等于、大于等于、小于等于、不等于分别问=、>=、<=、<>。

编写思路

　通过相应的基础扫盲，现在已经具备了一定的VBA编程的基础。通过对需求的解读，整理一下思路即可。
　首先定义双击事件，获取活动单元格的值，赋值给对应参数getValue。获取另一张表格已被使用的单元格行数，通过For循环遍历某列所有行，用于匹配getValue。第一次匹配成功为数据开始行，最后一次匹配成功为数据结束行。通过获取的行数，结合需要使用的列，获取需要的单元格区域。将此单元格区域通过图片生成的方式，显示在页面上。

总结

  1. VBA格式格式严谨，if、then、end if for、next with、end with都成对出现;
  2. VBA处理思路需要按照无到有的思路，如果已经执行过copy，需要先清空，才能再次执行;
  3. 图片生成之后，需要定义出现的位置。不定义出现位置，导致图片直接顶格出现;
  4. 该例子在图片生成之前会清空所有图片，不清空，每次双击对应单元格就会生成一张图片;
  5. 一开始准备用自定义函数来编写，后面发现本身集成了需要对应的函数(单机事情、双击事情)，因此，对一门语言了解其自带的函数很重要。

完整代码

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'sheet1双击事情
    For Each im In ActiveSheet.Shapes '删除所有图片
        im.Delete
    Next
    
    Dim getValue As String '单元格值
    Dim getInt As Integer '第一次出现行数
    Dim getInt2 As Integer '最后出现行数
    Dim getNum As Integer '用于判断是否是第一次
    
    
    getInt = 0 '初始化
    getInt2 = 0 '初始化
    getNum = 0 '初始化
    

    getValue = Range(Target.Address) '获取当前活动单元格地址
    If Target.Column = 1 Then '判断是否为sheet1中的A列
        For i = 1 To Sheet2.UsedRange.Rows.Count '遍历sheet2已经被使用单元格的行数
            If Sheet2.Range("A" & i) = getValue Then '取得sheet2的A列中第一次出现、最后一次出现的行数
                If getNum = 0 Then
                    getInt = i
                Else
                    getInt2 = i
                End If
                getNum = getNum + 1
            End If
        Next
    End If
    
    If getInt2 = 0 Then
        getInt2 = getInt
    End If
    
    '遍历获取所有单元格
    If getInt <> 0 Then
        Sheet2.Range("A" & getInt - 2 & ":D" & getInt2).Copy
        ActiveSheet.Pictures.Paste(Link:=True).Select
        With ActiveSheet.Pictures
            .Left = 400
            .Top = 0
        End With
        Application.CutCopyMode = False
    Else
        Sheet2.Range("A1:D2").Copy
        ActiveSheet.Pictures.Paste(Link:=True).Select
        With ActiveSheet.Pictures
            .Left = 400
            .Top = 0
        End With
        Application.CutCopyMode = False
    End If
End Sub