时间戳

首页 > 解决方案 > 为什么调整图像大小的 for 循环在 $A$1 上运行良好，但在其他情况下给出的高度和/或宽度为 0？

excel - 为什么调整图像大小的 for 循环在 $A$1 上运行良好，但在其他情况下给出的高度和/或宽度为 0？

问题描述

我的代码调整了图像的大小。如果图像的 TopLeftCell 是 $A$1，它将起作用。但是，如果它是任何其他单元格，则宽度或高度最终为 0。

它应该通过两个函数运行：getCellHeight 和 getCellWidth 来获取合并单元格的总高度和宽度，但它也适用于非合并单元格，只要 TopLeftCell 为 $A$1。

使用非合并单元格时：

n 大于 1 的任何 $A$n 都会导致宽度为 0 高度。

n 大于 A 的任何 $(n)$1 都会导致高度为 0 宽度。

n 大于 A 且 m 大于 1 的任何 $(n)$(m) 都会导致 0 高度和 0 宽度。

使用合并单元格时：

该功能类似于非合并单元格，不同之处在于在 $(n)$(m) 上，它只会在以下情况下运行循环的高度和宽度：

合并的行数 >= 9。在 9 行时，用于计算行数的 for 循环将运行一次。

合并的列数 >= 7。在 7 列中，用于计算列的 for 循环将运行一次。

任何低于 9 行的结果为 0 高度，任何低于 7 行的结果为 0 宽度。

这是代码：

Sub TestCode()
    If TypeOf Selection Is Picture Then
        Call ResizeSingleImage(Selection)
    ElseIf TypeOf Selection Is DrawingObjects Then
        Call ResizeMultipleImages(Selection)
    ElseIf TypeOf Selection Is Range Then
        MsgBox ("Please make sure an image is selected.")
        Exit Sub
    End If
End Sub

Function ResizeMultipleImages(ByRef refPictures)
    For Each refPic In refPictures
        Call ResizeSingleImage(refPic)
    Next
End Function

Function ResizeSingleImage(ByRef refPicture)
    refPicture.ShapeRange.LockAspectRatio = msoTrue

    MsgBox ("TopLeftCell: " & refPicture.TopLeftCell.Address)

    tempWidth = getCellWidth(refPicture.TopLeftCell)
    tempHeight = getCellHeight(refPicture.TopLeftCell)

    MsgBox ("Width and Height: " & tempWidth & " " & tempHeight)

    If tempWidth > tempHeight Then
        refPicture.Height = tempHeight
    Else
        refPicture.Width = tempWidth
    End If
End Function

Function getCellHeight(ByRef cellRef As Range) As Single
    curColumn = cellRef.Column
    curRow = cellRef.Row

    numOfRows = cellRef.MergeArea.Rows.Count
    totalHeight = 0

    MsgBox (cellRef.Address & " Rows: " & numOfRows)
    MsgBox ("Cell Height: " & cellRef.Height)
    For cRow = curRow To numOfRows
        MsgBox ("In Row For Loop")
        totalHeight = totalHeight + Cells(curColumn, cRow).Height
    Next

    getCellHeight = totalHeight
End Function

Function getCellWidth(ByRef cellRef As Range) As Single
    MsgBox (cellRef.Address)
    curColumn = cellRef.Column
    curRow = cellRef.Row

    numOfColumns = cellRef.MergeArea.Columns.Count
    totalWidth = 0

    For col = curColumn To numOfColumns
        MsgBox ("In Column For Loop")
        totalWidth = totalWidth + Cells(curRow, col).Width
    Next

    MsgBox (cellRef.Address & " Columns: " & numOfColumns)
    getCellWidth = totalWidth
End Function

标签： excelvba

解决方案

测试：

Sub Tester()
    ResizeSingleImage ActiveSheet.Shapes(1)
End Sub



Sub ResizeSingleImage(ByRef refPicture)

    Dim rng As Range, tempWidth, tempHeight
    Set rng = refPicture.TopLeftCell.MergeArea

    refPicture.Top = rng.Top
    refPicture.Left = rng.Left

    tempWidth = rng.Width
    tempHeight = rng.Height

    refPicture.LockAspectRatio = msoTrue
    'which dimension to resize?
    If tempWidth / refPicture.Width > tempHeight / refPicture.Height Then
        refPicture.Height = tempHeight
    Else
        refPicture.Width = tempWidth
    End If
End Sub

原始循环的问题：假设 cellRef 是A5

Function getCellHeight(ByRef cellRef As Range) As Single

    curColumn = cellRef.Column
    curRow = cellRef.Row                      '<< for A5 curRow = 5

    numOfRows = cellRef.MergeArea.Rows.Count  '<< let's say 4 rows
    totalHeight = 0

    MsgBox (cellRef.Address & " Rows: " & numOfRows)
    MsgBox ("Cell Height: " & cellRef.Height)


    For cRow = curRow To numOfRows  '<<<<this loops from 5 to 4....
        'code in loop doesn't execute....
        MsgBox ("In Row For Loop")
        totalHeight = totalHeight + Cells(curColumn, cRow).Height
    Next

    getCellHeight = totalHeight
End Function

推荐阅读