设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 请VBA大师帮忙?
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 1559|回复: 7

[已解决]请VBA大师帮忙?

[复制链接]
qqyyh
发表于 2012-8-2 21:41 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
请VBA大师帮忙:
(插入图片的代码)(图片比较多,从Case "C3"     P = "144.JPG"写到Case "C500"    P = "144.JPG"比较麻烦,请帮忙写个循环,简化一下代码)谢谢!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Image1
        Select Case ActiveCell.Address(False, False)
            Case "C3"
                P = "100.JPG"
            Case "C4"
                P = "101.JPG"
            Case "C5"
                P = "102.JPG"
            Case "C6"
                P = "103.JPG"
            Case "C7"
                P = "104.JPG"
            Case "C8"
                P = "105.JPG"
            Case "C9"
                P = "106.JPG"
            Case "C10"
                P = "107.JPG"
            Case "C11"
                P = "108.JPG"
            Case "C12"
                P = "109.JPG"
            Case "C13"
                P = "110.JPG"
            Case "C14"
                P = "111.JPG"
            Case "C15"
                P = "112.JPG"
            Case "C16"
                P = "113.JPG"
            Case "C17"
                P = "114.JPG"
            Case "C18"
                P = "115.JPG"
            Case "C19"
                P = "116.JPG"
            Case "C20"
                P = "117.JPG"
            Case "C21"
                P = "118.JPG"
            Case "C22"
                P = "119.JPG"
            Case "C23"
                P = "120.JPG"
            Case "C24"
                P = "121.JPG"
            Case "C25"
                P = "122.JPG"
            Case "C26"
                P = "123.JPG"
            Case "C27"
                P = "124.JPG"
            Case "C28"
                P = "125.JPG"
            Case "C29"
                P = "126.JPG"
            Case "C30"
                P = "127.JPG"
            Case "C31"
                P = "128.JPG"
            Case "C32"
                P = "129.JPG"
            Case "C33"
                P = "130.JPG"
            Case "C34"
                P = "131.JPG"
            Case "C35"
                P = "132.JPG"
            Case "C36"
                P = "133.JPG"
            Case "C37"
                P = "134.JPG"
            Case "C38"
                P = "135.JPG"
            Case "C39"
                P = "136.JPG"
            Case "C40"
                P = "137.JPG"
            Case "C41"
                P = "138.JPG"
            Case "C42"
                P = "139.JPG"
            Case "C43"
                P = "140.JPG"
            Case "C44"
                P = "141.JPG"
            Case "C45"
                P = "142.JPG"
            Case "C46"
                P = "143.JPG"
            Case "C47"
                P = "144.JPG"
            Case "C48"
                P = "145.JPG"
            Case "C49"
                P = "146.JPG"
            Case "C50"
                P = "147.JPG"
            Case "C51"
                P = "148.JPG"
            Case "C52"
                P = "149.JPG"
            Case "C53"
                P = "150.JPG"
            Case Else
                .Visible = False
                Exit Sub
        End Select
        .Picture = LoadPicture(ThisWorkbook.Path & "\pic\" & P)
        .Visible = True
    End With
    With ActiveCell
        Image1.Top = .Top - Image1.Height / 2
        Image1.Left = .Left + .Width
    End With
End Sub
最佳答案
月排行榜 / 总排行榜
mxg825
2012-8-2 22:29
qqyyh 发表于 2012-8-2 22:07
我怎么测试不成功?还是上传附件给你看看.谢谢!

工作表没有图控件！
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
mxg825
发表于 2012-8-2 21:50 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 mxg825 于 2012-8-2 21:54 编辑
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     With Image1
  3.         If Target.Row > 2 And Target.Row < 51 Then
  4.             .Picture = LoadPicture(ThisWorkbook.Path & "\pic" & Target.Row + 97 & ".jpg")
  5.             .Top = Target.Top - Image1.Height / 2
  6.             .Left = Target.Left + Target.Width
  7.             .Visible = True
  8.           Else
  9.             .Visible = False
  10.              Exit Sub
  11.         End If
  12.     End With
  13. End Sub
复制代码
回复

使用道具 举报

发表于 2012-8-2 22:04 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上

  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3. Dim P As String
  4.   Image1.Visible = False
  5.   With Target
  6.     If .Count > 1 Then Exit Sub   '如果选择的单元格个数大于1 ,则退出
  7.     If .Column <> 3 Then Exit Sub '如果选择的不是第三列,则退出
  8.     If .Row < 3 Then Exit Sub '如果选择的单元格小于第三行,则退出
  9.     '最大是多少行,你自己添加吧
  10.    
  11.     With Image1
  12.       P = Target.Row + 97 & ".jpg"  '设置文件名,选择单元格的行数 +97 就是你对应的 文件
  13.       .Picture = LoadPicture(ThisWorkbook.Path & "\pic" & P)
  14.       .Visible = True
  15.      End With
  16.     Image1.Top = .Top - Image1.Height / 2
  17.     Image1.Left = .Left + .Width
  18.   End With
  19. End Sub
复制代码
回复

使用道具 举报

qqyyh
 楼主| 发表于 2012-8-2 22:07 | 显示全部楼层
本帖最后由 qqyyh 于 2012-8-3 11:53 编辑

mxg825 发表于 2012-8-2 21:50



我怎么测试不成功?还是上传附件给你看看.谢谢!
新建文件夹.rar (140.67 KB, 下载次数: 6)
回复

使用道具 举报

mxg825
发表于 2012-8-2 22:29 | 显示全部楼层    本楼为最佳答案   
qqyyh 发表于 2012-8-2 22:07
我怎么测试不成功?还是上传附件给你看看.谢谢!

工作表没有图控件！

新建文件夹.rar

230.13 KB, 下载次数: 13
回复

使用道具 举报

发表于 2012-8-2 22:30 | 显示全部楼层
qqyyh 发表于 2012-8-2 22:07
我怎么测试不成功?还是上传附件给你看看.谢谢!


既然 单元格里的数字就是对应的 图片名称,那就直接调用就是了嘛

  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3. Dim P As String, Shap As Shape
  4.   For Each Shap In Sheet1.Shapes
  5.     If InStr(1, Shap.Name, "Picture") Then Shap.Delete
  6.   Next
  7.   'Image1.Visible = False
  8.   With Target
  9.     If .Count > 1 Then Exit Sub   '如果选择的单元格个数大于1 ,则退出
  10.     If .Column <> 2 Then Exit Sub '如果选择的不是第三列,则退出
  11.     If .Row < 2 Then Exit Sub '如果选择的单元格小于第三行,则退出
  12.     If .Value = "" Then Exit Sub
  13.    
  14.     P = ThisWorkbook.Path & "\pic" & .Value & ".jpg"
  15.     If Len(Dir(P)) = 0 Then Exit Sub
  16.     With Pictures.Insert(P)
  17.       .ShapeRange.IncrementLeft Target.Left + 10
  18.     End With
  19.   End With
  20. End Sub

复制代码
回复

使用道具 举报

发表于 2012-8-2 22:41 | 显示全部楼层
本帖最后由 无聊的疯子 于 2012-8-2 22:43 编辑

刚才没有找到 Image 控件,用的插入图片的方式,

这个是用的 image 控件的

  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3. Dim P As String
  4.   With Target
  5.     Image1.Visible = False
  6.     If .Count > 1 Then Exit Sub   '如果选择的单元格个数大于1 ,则退出
  7.     If .Column <> 2 Then Exit Sub '如果选择的不是第三列,则退出
  8.     If .Row < 2 Then Exit Sub '如果选择的单元格小于第三行,则退出
  9.     If .Value = "" Then Exit Sub   '如果单元格没有值,则退出
  10.     P = ThisWorkbook.Path & "\pic" & .Value & ".jpg"
  11.     If Len(Dir(P)) = 0 Then Exit Sub   '如果图片不存在,则退出
  12.     With Image1
  13.       .Picture = LoadPicture(P)
  14.      .Top = Target.Top - Image1.Height / 2
  15.       .Left = Target.Left + Target.Width+10
  16.       .Visible = True
  17.     End With
  18.   End With
  19. End Sub
复制代码

评分

参与人数 1 +12 收起 理由
mxg825 + 12 赞一个! 代码更周全一点

查看全部评分

回复

使用道具 举报

qqyyh
 楼主| 发表于 2012-8-3 09:56 | 显示全部楼层
都是我的老师,但是最佳只能一个,没办法.还是给最先回答的.谢谢你们的帮助!!!

点评

mxg825
建议用 7楼的代码，直接引用单元格的文本名称！  发表于 2012-8-3 10:37
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-29 03:14 , Processed in 0.265747 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表