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

kdsea

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

lss001

把以下→指定位置代码
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

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

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

lss001

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

sdytsxd991122

kdsea

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

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

kdsea

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

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

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

lss001

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

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