Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4028|回复: 2

[已解决]求助VBA按钮位置帮助

[复制链接]
发表于 2013-6-22 11:06 | 显示全部楼层 |阅读模式
想把VBA按钮的位置固定为一个单元格。请大侠帮助。
最佳答案
2013-6-22 11:35
  1. Sub test()
  2.     Dim shp As Shape
  3.     Dim objRg As Range
  4.    
  5.     On Error GoTo ErrorHandler
  6.     For Each shp In ActiveSheet.Shapes
  7.         With shp
  8.             Select Case .DrawingObject.Caption
  9.                 Case "方案一"
  10.                     Set objRg = Range("A10")
  11.                 Case "方案二"
  12.                     Set objRg = Range("A11")
  13.                 Case "方案三"
  14.                     Set objRg = Range("A12")
  15.                 Case Else
  16.                     Set objRg = Nothing
  17.             End Select
  18.             If Not objRg Is Nothing Then
  19.                 .Placement = xlMoveAndSize
  20.                 With .DrawingObject
  21.                     .Left = objRg.Left
  22.                     .Top = objRg.Top
  23.                     .Height = objRg.Height
  24.                     .Width = objRg.Width
  25.                 End With
  26.             End If
  27.         End With
  28.     Next
  29.     MsgBox "OK"
  30.     Exit Sub
  31. ErrorHandler:
  32.     MsgBox Err.Number & vbCrLf & _
  33.            Err.Description
  34. End Sub
复制代码

求助VBA按钮位置帮助.zip

8.19 KB, 下载次数: 18

发表于 2013-6-22 11:31 | 显示全部楼层
  1. Sub test()
  2.     Dim shp As Shape
  3.     Dim strRg As String
  4.     For Each shp In ActiveSheet.Shapes
  5.         With shp
  6.             Select Case .DrawingObject.Caption
  7.                 Case "方案一"
  8.                     strRg = "A10"
  9.                 Case "方案二"
  10.                     strRg = "A11"
  11.                 Case "方案三"
  12.                     strRg = "A12"
  13.             End Select
  14.             .Placement = xlMoveAndSize
  15.             With .DrawingObject
  16.                 .Left = Range(strRg).Left
  17.                 .Top = Range(strRg).Top
  18.                 .Height = Range(strRg).Height
  19.                 .Width = Range(strRg).Width
  20.             End With
  21.         End With
  22.     Next
  23.     MsgBox "OK"
  24. End Sub
复制代码
回复

使用道具 举报

发表于 2013-6-22 11:35 | 显示全部楼层    本楼为最佳答案   
  1. Sub test()
  2.     Dim shp As Shape
  3.     Dim objRg As Range
  4.    
  5.     On Error GoTo ErrorHandler
  6.     For Each shp In ActiveSheet.Shapes
  7.         With shp
  8.             Select Case .DrawingObject.Caption
  9.                 Case "方案一"
  10.                     Set objRg = Range("A10")
  11.                 Case "方案二"
  12.                     Set objRg = Range("A11")
  13.                 Case "方案三"
  14.                     Set objRg = Range("A12")
  15.                 Case Else
  16.                     Set objRg = Nothing
  17.             End Select
  18.             If Not objRg Is Nothing Then
  19.                 .Placement = xlMoveAndSize
  20.                 With .DrawingObject
  21.                     .Left = objRg.Left
  22.                     .Top = objRg.Top
  23.                     .Height = objRg.Height
  24.                     .Width = objRg.Width
  25.                 End With
  26.             End If
  27.         End With
  28.     Next
  29.     MsgBox "OK"
  30.     Exit Sub
  31. ErrorHandler:
  32.     MsgBox Err.Number & vbCrLf & _
  33.            Err.Description
  34. End Sub
复制代码
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 04:23 , Processed in 0.397225 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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