Trasferimento di immagini tra le celle in VBA

Ho un'image in cella (3,1) e vorrei spostare l'image in cella (1,1).

Ho questo codice:

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

Tuttavia, sembra che il valore della cella sia vuoto per le celle contenenti immagini, quindi l'image non viene spostata e l'image in cella (3,1) non viene eliminata. Nulla è accaduto quando eseguo quel particolare pezzo del codice.

Qualsiasi aiuto è molto apprezzato.

Grazie.

Solutions Collecting From Web of "Trasferimento di immagini tra le celle in VBA"

Parte del problema con il codice è che stai pensando all'image come valore della cella. Tuttavia, anche se l'image potrebbe apparire "in" la cella, non è in realtà il valore della cella.

Per spostare l'image, è ansible farlo relativamente (utilizzando Shape.IncrementLeft o Shape.IncrementRight ) oppure è ansible farlo assolutamente (impostando i valori di Shape.Left e Shape.Top ).

Nell'esempio che segue mostro come puoi spostare la forma in una nuova posizione assoluta con o senza mantenere l'indentazione originale dalla cella originale (se non stai mantenendo l'indentazione originale, questo è semplice come impostare la parte Top e Left i valori della Shape siano uguali a quelli della Range destinazione).

Questa procedura prende in considerazione un nome di forma (puoi trovare il nome della forma in un certo numero di modi: il modo in cui ho fatto era registrare una macro e quindi click sulla forma e spostarla per vedere il codice generato), l'indirizzo di destinazione (ad esempio "A1" e (opzionalmente) un valore boolean che indica se si desidera mantenere l'offset originale di indentazione.

 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 

NOTA: Ho scritto il codice in modo molto funzionale. Se voleste "pulire" questo codice, sarebbe meglio mettere la funzionalità all'interno di un object. Speriamo che il lettore capisca come le forms funzionano in Excel in entrambi i modi.

Un modo veloce e sporco:

 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