因图片旋转了90度，不能对齐到单元格的顶端

kdsea · 发表于 2024-10-26 14:14

本帖最后由 kdsea 于 2024-10-26 16:30 编辑

因图片旋转了90度，不能对齐到单元格A1的顶端代码 img.Top = 0 失效请老师指导万分感谢🙏

lss001 · 发表于 2024-10-26 17:19

本帖最后由 lss001 于 2024-10-26 21:41 编辑

把以下→指定位置代码
img.Top = 0
img.Left = 0
替换为→移动位置代码
t = Timer '延时等待图片加载完成
While Timer < t + 2: DoEvents: Wend
xTop! = img.Top
xLeft! = img.Left
img.ShapeRange.IncrementTop -xTop * 72
img.ShapeRange.IncrementLeft -xLeft * 72
img.Visible = True

kdsea · 发表于 2024-10-26 20:25

lss001 发表于 2024-10-26 17:19
把以下→指定位置代码
img.Top = 0
img.Left = 0

谢谢指导，但是经测试，仍不能对齐到表格上边线。（图片经旋转顶端属性发生的变化。）

lss001 · 发表于 2024-10-26 21:43

加上延时等待图片加载完成
请参考楼上更新代码

sdytsxd991122 · 发表于 2024-10-26 22:32

kdsea · 发表于 2024-10-27 09:05

sdytsxd991122 发表于 2024-10-26 22:32

使用WPS 测试失败  使用MS office 改为img.Left = 0
         img.Top = 0
         img.ShapeRange.IncrementTop -90  通过

kdsea · 发表于 2024-10-27 09:34

sdytsxd991122 发表于 2024-10-26 22:32

Sub 批量打印图片()
Dim ws As Worksheet
Dim imgPath As String
Dim imgFile As String
Dim img As Picture
Dim imgHeight As Double
Dim imgWidth As Double
Dim cell As Range
Set ws = ThisWorkbook.Sheets(1)
Set cell = ws.Range("A1")
cell.RowHeight = 408.75
cell.ColumnWidth = 98.6
imgPath = ThisWorkbook.Path & "\"
imgFile = Dir(imgPath & "*.*")
Range("A1").Select
If InStr(imgFile, "批量") = 0 Then
      Do While imgFile <> "" And InStr(imgFile, "批量") = 0
         Set img = ws.Pictures.Insert(imgPath & imgFile)
         imgHeight = img.Height
         imgWidth = img.Width
         img.ShapeRange.LockAspectRatio = msoFalse
         If imgHeight > imgWidth Then
            img.ShapeRange.Rotation = 90
            img.Height = cell.Width
            img.Left = 0
            img.Top = 0
            img.ShapeRange.IncrementTop -10000
         Else
            img.Height = cell.Height
            img.Width = cell.Width
            img.Left = 0
            img.Top = 0
         End If
         ws.PrintOut
         img.Delete
         imgFile = Dir
      Loop
End If
End Sub    改为10000  在MS office 测试通过

kdsea · 发表于 2024-10-27 09:36

lss001 发表于 2024-10-26 21:43
加上延时等待图片加载完成
请参考楼上更新代码

在MS office 测试有时可以通过，但有时图片位于A1单元格下边

lss001 · 发表于 2024-10-27 09:43

本帖最后由 lss001 于 2024-10-27 10:56 编辑

kdsea 发表于 2024-10-27 09:36
在MS office 测试有时可以通过，但有时图片位于A1单元格下边

先加上延时
然后定位或选中图片
再移动图片

		自动登录	找回密码
密码			免费注册

[求助] 因图片旋转了90度，不能对齐到单元格的顶端