让excel照相机拍的图片底部始终与已输入数据的最后一行平齐

13782671637

各位老师：不知VBA能不能编写一段命令代码：让excel照相机拍的图片底部始终与已输入数据的最后一行强制平齐？如果可以，我就作个模拟结果的附件上传；如果不能，我也就死心了。 图片附件.zip (23.22 KB, 下载次数: 9)

2018-6-22 22:43 上传

点击文件名下载附件

huang1314wei

你还是上一个附件吧，不然不知道你在说什么

13782671637

huang1314wei 发表于 2018-6-22 22:05
你还是上一个附件吧，不然不知道你在说什么

版主老师：附件已上传。感谢提醒。

13782671637

huang1314wei 发表于 2018-6-22 22:05
你还是上一个附件吧，不然不知道你在说什么

老师：可以用VBA控制图片的显示位置吗？

huang1314wei

13782671637 发表于 2018-6-22 23:28
老师：可以用VBA控制图片的显示位置吗？

请见附件


图片附件.rar (24.53 KB, 下载次数: 12)

2018-6-23 08:18 上传

点击文件名下载附件

jiaxinl

13782671637 发表于 2018-6-22 23:28
老师：可以用VBA控制图片的显示位置吗？

1. 'ThisWorkbook
   
2. 
   
3. Option Explicit
   
4. 
   
5. Private Sub Workbook_Open()
   
6. timeX = 0
   
7. TimerID = SetTimer(0, 0, 100, AddressOf OnTimer)
   
8. End Sub
   
9. 
   
10. 
    
11. '图片跟随
    
12. 
    
13. Option Explicit
    
14. Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    
15. Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
    
16. Public TimerID As Long, timeX As Single
    
17. 
    
18. Public Sub OnTimer()
    
19. On Error Resume Next
    
20. timeX = timeX + 0.1
    
21. Sheet1.Shapes(1).Top = Rows(Sheet1.[A1048576].End(xlUp).Row - 33).Top
    
22. End Sub

复制代码

13782671637

huang1314wei 发表于 2018-6-23 08:18
请见附件

版主老师：请看截图：


原来VBA真的可以让图片跟随数据最后行移动啊！版主大人：能不能修改代码，1.突破65336行数的限制【就是因为数据量过大，十来万行，查看图片得返回工作表上方，太麻烦】；2.应该是数据最后行与图片下边缘平齐【大多数人习惯数据最后行靠近工作表底部，方便随时查看最近输入的二十来行数据；但截图显示的是：最近数据与截图错开了】。麻烦您修改代码为盼！

13782671637

jiaxinl 发表于 2018-6-23 09:06

非常感谢老师热情详尽的帮助！代码非常完美地实现了我的想法。学生还有几点疑惑向您请教：
Option Explicit
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long, timeX As Single
Public Sub OnTimer()
On Error Resume Next
timeX = timeX + 0.1
Sheet1.Shapes(1).Top = Sheet1.Rows(Sheet1.[A1048576].End(xlUp).Row - 33).Top
End Sub和
Option Explicit


Private Sub Workbook_Open()
timeX = 0
TimerID = SetTimer(0, 0, 100, AddressOf OnTimer)
End Sub

1.应该分别复制粘贴进实际工作表的哪个模块？2.代码里红色填充的数字代表什么意思？3.如果我要变更图片的行列大小，把原图片剪切后重新拍照，新图片怎么无法跟随数据输入动态移动了？

13782671637

huang1314wei 发表于 2018-6-23 08:18
请见附件

版主老师：麻烦您按7楼要求修改代码。

huang1314wei

13782671637 发表于 2018-6-23 16:41
版主老师：麻烦您按7楼要求修改代码。

6楼已经给了你答案