标题:VB编写excel表格生成时,断行怎么解决?烦请各位帮忙解决,谢谢!
只看楼主
wbailiang
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2019-3-15
 问题点数:0 回复次数:1 
VB编写excel表格生成时,断行怎么解决?烦请各位帮忙解决,谢谢!
先说明下:原表格是分上下两块,原表格上部分中标题栏占8行,填写部分15行,中间空一行,下部分表头占3行,填写部分占15行,现想只保留上半部分,不要下半部分,但生成后第一页生成正常,结果第二页生成表格时有断的。麻烦高手如何能生成连续的数据?程序中的程序有的可能是没有用,不专业,麻烦高手解决下,我是菜鸟,告诉我下怎么修改,详细些,万分感激!  第一张图为上下两块,第二张图为正常显示,第三张图为断开的图(不正常的图)


Sub 统计材料()

Dim k As Integer
   k = Sheets("操作表格").Range("c1").Value

        Sheets("全表").Select
        Range(Cells(7, 2), Cells(7, 60)).Select
        Selection.Copy
        Range(Cells(8, 2), Cells(k + 7, 60)).Select
        ActiveSheet.Paste
        '清除剪贴板
        Application.CutCopyMode = False
        ("Task Pane").Visible = False
      '转换为文字
    Range(Cells(8, 2), Cells(k + 7, 60)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        
        
   Sheets("操作表格").Select
End Sub
Sub 恢复初始()

'上下表格恢复初始

Dim k As Integer
    k = Sheets("操作表格").Range("c1").Value
   
    Sheets("上").Select
    Range(Cells(8, 2), Cells(k + 7, 60)).Select
    Selection.ClearContents
    Sheets("下").Select
    Range(Cells(8, 2), Cells(k + 7, 60)).Select
    Selection.ClearContents
    Sheets("操作表格").Select
   
Dim i As Integer
    i = Sheets("操作表格").Range("c2").Value
    Sheets("管段材料表").Select
     Range(Rows(42), Rows(i)).Select
'    Selection.Delete Shift:=xlUp
   Selection.ClearContents
   ActiveSheet.DrawingObjects.Delete
   ActiveSheet.PageSetup.PrintArea = "$B$1:$BD$41"
      Sheets("操作表格").Select
      
      
      
End Sub
Sub 上下恢复初始()

'上下表格恢复初始

Dim k As Integer
    k = Sheets("操作表格").Range("c1").Value
   
    Sheets("上").Select
    Range(Cells(8, 2), Cells(k + 7, 60)).Select
    Selection.ClearContents
    Sheets("下").Select
    Range(Cells(8, 2), Cells(k + 7, 60)).Select
    Selection.ClearContents
    Sheets("操作表格").Select
   
      Sheets("操作表格").Select
End Sub



Sub 复制管段材料表模板()
Dim i As Integer
Dim k As Integer

   k = Sheets("操作表格").Range("c2").Value
   
For i = 1 To k Step 41

    Sheets("模板").Select
    Rows("1:41").Select
    Selection.Copy
    Sheets("管道特性表").Select
    Range(Cells(i, 1), Cells(i + 40, 60)).Select
    ActiveSheet.Paste
 '清除剪贴板
 Application.CutCopyMode = False
 ("Task Pane").Visible = False
 
Next
  Sheets("操作表格").Select
 End Sub
 
Sub 生成管段材料表()


        
'第1页
    Sheets("全表").Select
    Rows("8:40").Select
    Selection.Copy
    Sheets("管道特性表").Select
    Rows("8:40").Select
    ActiveSheet.Paste
 '清除剪贴板
    Application.CutCopyMode = False
    ("Task Pane").Visible = False

  
 
 '清除剪贴板
    Application.CutCopyMode = False
    ("Task Pane").Visible = False

'第2页
Dim i As Integer
Dim j As Integer
Dim k As Integer
  j = 1
  k = Sheets("操作表格").Range("c4").Value
For i = 23 To k Step 15
    Sheets("全表").Select
    Range(Cells(i, 1), Cells(i + 14, 60)).Select
    Selection.Copy
    Sheets("管道特性表").Select
   Range(Cells(i + 26 * j, 1), Cells(i + 26 * j + 14, 60)).Select
    ActiveSheet.Paste
 '清除剪贴板
    Application.CutCopyMode = False
    ("Task Pane").Visible = False
   
 
 '清除剪贴板
    Application.CutCopyMode = False
    ("Task Pane").Visible = False
    j = j + 1
   
Next
  Sheets("管道特性表").Select
  ActiveSheet.PageSetup.PrintArea = "$B:$BD"
  Sheets("操作表格").Select

End Sub
搜索更多相关主题的帖子: 表格 操作 Select Application False 
2019-03-15 16:59
wlrjgzs
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:26
帖 子:212
专家分:1566
注 册:2017-4-10
得分:0 
楼主不认为留下个联系方式会更好交流吗
2019-03-16 09:54



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-493620-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.103263 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved