Foxtable(狐表)用户栏目专家坐堂 → EXCEL VBA复制时格式和内容一起复制问题


  共有5243人关注过本帖树形打印复制链接

主题:EXCEL VBA复制时格式和内容一起复制问题

帅哥,在线噢!
benwong2013
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:485 积分:4081 威望:0 精华:0 注册:2015/12/16 8:22:00
EXCEL VBA复制时格式和内容一起复制问题  发帖心情 Post By:2018/5/29 10:58:00 [只看该作者]

根据之前贴的内容已经完成了表单复制之后合并,但表格的行高无法复制,请问以下代码如何修改?


Dim Book As New XLS.Book(ProjectPath & "Attachments\出口公路舱单模板皇岗 - 副本1.xlsx")
Dim fl As String = ProjectPath & "reports\出口公路舱单模板皇岗 - 副本.xlsx"
Book.Build() '生成细节区
Book.Save(fl) '保存工作簿
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("预配(出口)舱单多piao模板") '指定要复制的工作表
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("sheet1")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("sheet2")

Ws2.UsedRange.Copy
ws1.Select
ws1.Cells(Ws1.UsedRange.Rows.Count+1,2).Select '纵向拷贝
ws1.paste

Ws3.UsedRange.Copy
ws1.Select
ws1.Cells(Ws1.UsedRange.Rows.Count+1,2).Select '纵向拷贝
ws1.paste

'Wb.Save
app.Visible = True
'App.Quit



 回到顶部
帅哥,在线噢!
benwong2013
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:485 积分:4081 威望:0 精华:0 注册:2015/12/16 8:22:00
  发帖心情 Post By:2018/5/29 11:00:00 [只看该作者]

要求复制粘贴的时候格式不变

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/5/29 11:43:00 [只看该作者]

比较麻烦,参考代码,细节自己调整


Dim fl As String = "d:\test.xls"
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("sheet3") '指定要复制的工作表
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("sheet1")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("sheet2")


Dim x As Integer = Ws1.UsedRange.Rows.Count+1

Ws2.UsedRange.Copy
ws1.Select
ws1.Cells(x,2).Select '纵向拷贝
ws1.paste

'设置列格式
ws2.Select
ws2.rows("1:" & ws2.UsedRange.rows.count).Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.rows(x & ":" & x+ws2.usedRange.rows.count).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False

'设置行格式
ws2.Select
ws2.columns(ws2.cells(1,1).address.split("$")(1) & ":" & ws2.cells(1,ws2.UsedRange.columns.count).address.split("$")(1)).Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.columns(ws1.cells(1,2).address.split("$")(1) & ":" &  ws1.cells(1,2+ws2.usedRange.columns.count).address.split("$")(1)).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False

'设置单元格格式
ws2.Select
ws2.UsedRange.Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Select
ws1.range(ws1.cells(x, 2).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, 2+ws2.UsedRange.columns.count).address).Select
msgbox(ws1.cells(x, 2).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, 2+ws2.UsedRange.columns.count).address)
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False

'Wb.Save
app.Visible = True
'App.Quit

 


 回到顶部