7,785
社区成员




Public Sub CopyBmpOne(i As Integer)
With XlApp.Selection
dCellW = Selection.Width
' ' dCellW = XlSheet.Cells(5, 1).Selection.Height
dCellH = Selection.Height
' End With
Clipboard.Clear
Clipboard.SetData img1Show(i).Picture
XlSheet.PasteSpecial Format:="位图", Link:=False, DisplayAsIcon:=False
'ActiveSheet.Pictures.Insert(img1Show(0).Picture).Select
dPicW = Selection.ShapeRange.Width
dPicH = Selection.ShapeRange.Height
'重新定位
Selection.ShapeRange.IncrementLeft (dCellW - dPicW) / 2
Selection.ShapeRange.IncrementTop (dCellH - dPicH) / 2
End With
End Sub
XlSheet.Cells(5, 1).Select
Call CopyBmpOne(0)
XlSheet.Cells(5, 3).Select
Call CopyBmpOne(1)
XlSheet.Cells(5, 5).Select
Call CopyBmpOne(2)
XlSheet.Cells(5, 7).Select
Call CopyBmpOne(3)
Public Sub CopyBmpOne(i As Integer)
With XlApp.Selection
dCellW = Selection.Width
' ' dCellW = XlSheet.Cells(5, 1).Selection.Height
dCellH = Selection.Height
' End With
Clipboard.Clear
Clipboard.SetData img1Show(i).Picture
XlSheet.PasteSpecial Format:="位图", Link:=False, DisplayAsIcon:=False
'ActiveSheet.Pictures.Insert(img1Show(0).Picture).Select
dPicW = Selection.ShapeRange.Width
dPicH = Selection.ShapeRange.Height
'重新定位
Selection.ShapeRange.IncrementLeft (dCellW - dPicW) / 2
Selection.ShapeRange.IncrementTop (dCellH - dPicH) / 2
End With
End Sub
这个是用来导入图片到excel并且使图片在单元格内居中显示
实际使用时我会重复调用
XlSheet.Cells(5, 1).Select
Call CopyBmpOne(0)
XlSheet.Cells(5, 3).Select
Call CopyBmpOne(1)
XlSheet.Cells(5, 5).Select
Call CopyBmpOne(2)
XlSheet.Cells(5, 7).Select
Call CopyBmpOne(3)
出错在dCellW = Selection.Width这里。会提示实时错误‘91’对象变量或with块未设置