वीबीए

Question

में कोशिकाओं के बीच छवियों को स्थानांतरित करना मेरे पास सेल (3,1) में एक छवि है और छवि को सेल (1,1) में स्थानांतरित करना चाहते हैं।

मैं इस कोड है:

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

हालांकि, ऐसा लगता है कि सेल मूल्य, इसलिए छवि नहीं ले जाया गया है चित्र युक्त कोशिकाओं के लिए कोई नहीं है और सेल में छवि (3,1) नहीं है नष्ट कर दिया। कुछ भी नहीं हुआ जब मैं कोड के उस विशेष बिट को चलाता हूं।

किसी भी मदद की बहुत सराहना की जाती है।

धन्यवाद।

Answer 1

आपके कोड के साथ समस्या का एक हिस्सा यह है कि आप छवि के मूल्य के रूप में छवि के बारे में सोच रहे हैं। हालांकि, हालांकि छवि सेल में "अंदर" प्रतीत हो सकती है, लेकिन यह वास्तव में सेल का मान नहीं है।

छवि को स्थानांतरित करने के लिए, यदि आप ऐसा अपेक्षाकृत (Shape.IncrementLeft या Shape.IncrementRight का प्रयोग करके) कर सकते हैं या आप इसे (Shape.Left और Shape.Top के मूल्यों की स्थापना द्वारा) बिल्कुल कर सकते हैं।

नीचे दिए गए उदाहरण में, मैं दिखाता हूं कि आप मूल सेल के मूल इंडेंटेशन को बंद किए बिना या बिना किसी नए पूर्ण स्थिति में आकार कैसे ले जा सकते हैं (यदि आप मूल इंडेंटेशन नहीं रखते हैं, तो यह सेटिंग के रूप में सरल है Top और LeftShape के मान 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 

नोट:।। मैं बहुत ज्यादा एक कार्यात्मक तरीके से कोड लिखा था आप तो इस कोड को "साफ" करना चाहते थे, कार्यक्षमता को किसी ऑब्जेक्ट में रखना सबसे अच्छा होगा। उम्मीद है कि यह पाठक को यह समझने में सहायता करता है कि एक्सेल में आकार कैसे काम करता है।

Answer 2

एक त्वरित और गंदा तरीका:

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