Vb.net 使用VB从一个excel粘贴到另一个excel时的图像重叠

我试图将几个图像从一个excel粘贴到另一个excel，但遇到了一个问题。图像相互重叠，甚至大小都很小。下面是我尝试的代码

If Source = ESNAME Then
    Dim shp As Microsoft.Office.Interop.Excel.Shape
    Dim lCol As Integer = 0
    Dim I As Integer = 1
    '~~> Loop through all shapes and find the last col of the shape
    For Each shp In WS.Shapes
        If shp.BottomRightCell.Column > lCol Then _
        lCol = shp.BottomRightCell.Column



        With WS
            '~~> Find actual last Row
            Dim LastRow As Integer = I
            Dim LastColumn As Integer = I
            Dim str As String = "B" & I & "@"

            '~~> Check if we have the correct last columnm
            If LastColumn < lCol Then LastColumn = lCol
            .Range(str.Replace("@", ":") & Split(.Cells(, LastColumn).Address, "$")(1) & LastRow).Copy()
            Dim sheet As Microsoft.Office.Interop.Excel.Worksheet
            sheet = Nothing
            sheet = DW.Worksheets(1)
            sheet.Paste()


        End With
        I = I + 1
    Next
End If

如果Source=ESNAME那么
将shp变暗为Microsoft.Office.Interop.Excel.Shape
Dim lCol作为整数=0
尺寸I为整数=1
“~~>循环遍历所有形状并找到形状的最后一列
对于WS.形状中的每个shp
如果shp.BottomRightCell.Column>lCol，则_
lCol=shp.BottomRightCell.Column
与WS
“~~>查找实际的最后一行
Dim LastRow作为整数=I
Dim LastColumn作为整数=I
Dim str As String=“B”&I&@
“~~>检查最后一列是否正确
如果LastColumn

---

提前谢谢。

假设您的工作簿1是这样的

尝试此代码（在VS 2010+OFFICE 2010中进行了尝试和测试）

代码

Imports Excel = Microsoft.Office.Interop.Excel

Public Class Form1
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        '~~> Define your Excel Objects
        Dim xlApp As New Excel.Application
        Dim xlWorkBook1 As Excel.Workbook = Nothing
        Dim xlWorkBook2 As Excel.Workbook = Nothing
        Dim xlWorkSheet1 As Excel.Worksheet = Nothing
        Dim xlWorkSheet2 As Excel.Worksheet = Nothing

        '~~> Display Excel
        xlApp.Visible = True

        '~~> Open relevant excel files and set your objects
        xlWorkBook1 = xlApp.Workbooks.Open("C:\book1.xlsx")
        xlWorkSheet1 = xlWorkBook1.Sheets("Sheet1")

        xlWorkBook2 = xlApp.Workbooks.Open("C:\book2.xlsx")
        xlWorkSheet2 = xlWorkBook2.Sheets("Sheet2")

        Dim xlShp As Excel.Shape = Nothing
        Dim xlShape As Excel.Shape = Nothing

        For Each xlShp In xlWorkSheet1.Shapes
            xlShp.Copy()
            xlWorkSheet2.Paste(Destination:=xlWorkSheet2.Range("A1"))
        Next

        Dim col1 As New Point(10, 10)
        Dim col2 As New Point(col1.X * 2 + xlWorkSheet2.Shapes(0).Width, 10)
        Dim stdHeight As Integer = CType(xlWorkSheet2.Shapes(0), Excel.Shape).Height + 5

        For i As Integer = 0 To xlWorkSheet2.Shapes.Count - 1 Step 2
            xlShape = xlWorkSheet2.Shapes(i)
            xlShape.Left = col1.X
            xlShape.Top = col1.Y + i * stdHeight

            xlShape = xlWorkSheet2.Shapes(i + 1)
            xlShape.Left = col2.X
            xlShape.Top = col2.Y + i * stdHeight
        Next

        '~~> Save the file
        xlWorkBook2.Save()

        '~~> Close the File
        xlWorkBook1.Close (False)
        xlWorkBook2.Close (False)

        '~~> Quit the Excel Application
        xlApp.Quit()

        '~~> Clean Up
        releaseObject (xlShp)
        releaseObject (xlShape)
        releaseObject (xlWorkSheet1)
        releaseObject (xlWorkSheet2)
        releaseObject (xlWorkBook1)
        releaseObject (xlWorkBook2)

        releaseObject (xlApp)
    End Sub

    '~~> Release the objects
    Private Sub releaseObject(ByVal obj As Object)
        Try
            System.Runtime.InteropServices.Marshal.ReleaseComObject (obj)
            obj = Nothing
        Catch ex As Exception
            obj = Nothing
        Finally
            GC.Collect()
        End Try
    End Sub
End Class

工作簿2输出

---

你想把形状一个贴在另一个下面还是贴在另一个旁边？我需要两张图片排成一行，总共有6张图片，我需要排成一行的两张图片都是正确的，但是应该排在另一行的图片都是重叠的。2然后低于2，低于2？没错，甚至是一个细胞的大小。我需要更大的图像。还有最后一个问题。在复制形状之前，工作表中是否还有其他形状？