Вопрос: Перемещение изображений между ячейками в VBA


У меня есть изображение в ячейке (3,1) и вы хотите переместить изображение в ячейку (1,1).

У меня есть этот код:

ActiveSheet.Cells(1, 1).Value = ActiveSheet.Cells(3, 1).Value
ActiveSheet.Cells(3, 1).Value = ""

Однако кажется, что значение ячейки пусто для ячеек, содержащих изображения, поэтому изображение не перемещается, а изображение в ячейке (3,1) не удаляется. Ничего не случилось, когда я запустил этот бит кода.

Любая помощь приветствуется.

Благодарю.


8


источник


Ответы:


Часть проблемы с вашим кодом заключается в том, что вы думаете об изображении как о стоимость  клетки. Однако, хотя изображение может оказаться «в» ячейке, на самом деле это не значение ячейки.

Чтобы переместить изображение, вы можете сделать это относительно  (с помощью Shape.IncrementLeft или Shape.IncrementRight), или вы можете это сделать абсолютно  (установив значения Shape.Left а также Shape.Top).

В приведенном ниже примере я демонстрирую, как вы можете переместить фигуру в новую абсолютную позицию с сохранением исходного отступа в исходной ячейке или без нее (если вы не сохраняете исходный отступ, это так же просто, как установка Top а также Left значения Shape быть равным таковым для целевой Range).

Эта процедура принимает имя формы (вы можете найти имя формы несколькими способами, так как я сделал это, это записать макрос, а затем щелкнуть по фигуре и переместить его, чтобы увидеть код, который он сгенерировал), целевой адрес (такие как "A1", и (необязательно) логическое значение, указывающее, хотите ли вы сохранить исходное смещение отступа.

Sub ShapeMove(strShapeName As String, _
    strTargetAddress As String, _
    Optional blnIndent As Boolean = True)
Dim ws As Worksheet
Dim shp As Shape
Dim dblCurrentPosLeft As Double
Dim dblCurrentPosTop As Double
Dim rngCurrentCell As Range
Dim dblCurrentCellTop As Double
Dim dblCurrentCellLeft As Double
Dim dblIndentLeft As Double
Dim dblIndentTop As Double
Dim rngTargetCell As Range
Dim dblTargetCellTop As Double
Dim dblTargetCellLeft As Double
Dim dblNewPosTop As Double
Dim dblNewPosLeft As Double

'Set ws to be the ActiveSheet, though this can really be any sheet      '
Set ws = ActiveSheet

'Set the shp variable as the shape with the specified shape name  '
Set shp = ws.Shapes(strShapeName)

'Get the current position of the image on the worksheet                 '
dblCurrentPosLeft = shp.Left
dblCurrentPosTop = shp.Top

'Get the current cell range of the image                                '
Set rngCurrentCell = ws.Range(shp.TopLeftCell.Address)

'Get the absolute position of the current cell                          '
dblCurrentCellLeft = rngCurrentCell.Left
dblCurrentCellTop = rngCurrentCell.Top

'Establish the current offset of the image in relation to the top left cell'
dblIndentLeft = dblCurrentPosLeft - dblCurrentCellLeft
dblIndentTop = dblCurrentPosTop - dblCurrentCellTop

'Set the rngTargetCell object to be the address specified in the paramater '
Set rngTargetCell = ws.Range(strTargetAddress)

'Get the absolute position of the target cell       '
dblTargetCellLeft = rngTargetCell.Left
dblTargetCellTop = rngTargetCell.Top

'Establish the coordinates of the new position. Only indent if the boolean '
' parameter passed in is true. '
' NB: The indent can get off if your indentation is greater than the length '
' or width of the cell '
If blnIndent Then
    dblNewPosLeft = dblTargetCellLeft + dblIndentLeft
    dblNewPosTop = dblTargetCellTop + dblIndentTop
Else
    dblNewPosLeft = dblTargetCellLeft
    dblNewPosTop = dblTargetCellTop
End If

'Move the shape to its new position '
shp.Top = dblNewPosTop
shp.Left = dblNewPosLeft

End Sub

ПРИМЕЧАНИЕ. Я написал код очень функционально. Если вы хотите «очистить» этот код, лучше всего разместить функциональность внутри объекта. Надеюсь, это поможет читателю понять, как формы работают в Excel в любом случае.


7



Быстрый и грязный способ:

Public Sub Example()
    MoveShape ActiveSheet.Shapes("Picture 1"), Range("A1")
End Sub

Private Sub MoveShape(ByVal shp As Excel.Shape, ByVal target As Excel.Range)
    shp.IncrementLeft -(shp.TopLeftCell.Left - target.Left)
    shp.IncrementTop -(shp.TopLeftCell.Top - target.Top)
End Sub

3