以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  设置excel表页面出错请解决  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=132258)

--  作者:hpbcfmqr
--  发布时间:2019/3/18 13:41:00
--  设置excel表页面出错请解决
老师,请帮忙看看下面代码,有一行不知道怎么都过不了
Dim ddj As String="D:\\封面目录\\000封面目录备考表fmmlbkb.xls"


Dim App As New MSExcel.Application
App.Visible = True

Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(ddj)

Dim sheet As MSExcel.WorkSheet = Wb.WorkSheets("卷内目录")


     Sheet.PageSetup.PrintArea = ""
 
Dim nqx As Integer    
     
 For nqx = 0 To 1500

If Sheet.Cells(3 + nqx, 4).Value = "" And _
Sheet.Cells(4 + nqx, 4).Value = "" And _
Sheet.Cells(5 + nqx, 4).Value = "" Then

Exit For
End If

Next nqx


Dim  hhu As  String = "A3:G" & nqx + 2

 Sheet.Range(hhu).Rows.AutoFit
 
Dim sb As Integer

For sb = 0 To nqx + 2 + 15


Dim mm As String = 3 + sb & ":" & 3 + sb
 
If Sheet.Rows(mm).RowHeight < 42.75 Then
 
Sheet.Rows(mm).RowHeight = 42.75
 
 End If
 
3377:

 Next sb
 


Dim pages 
      
 Dim Rg As MSExcel.Range = Sheet.Cells
  
 Dim HBreaks

Dim  NumPages 

    Dim Rng As  MSExcel.Range 
    Dim Sht As   MSExcel.WorkSheet = Sheet
   
    
    \'计算总页数
    HBreaks = Sht.HPageBreaks.Count
        
    NumPages = (HBreaks + 1)
    
    
    \'计算某单元格的当前页
     Rng = Sheet.Cells(2 + nqx, 4)

 
  Dim iii as  Integer  
     
    For iii = 1 To HBreaks
      If Sht.HPageBreaks(iii).Location.Row > nqx + 2 Then Exit For \'获取此页行号,运行这里出错
    Next
    
       
    Sheet.PageSetup.PrintArea = "$A$1:$G$" & Sht.HPageBreaks(iii).Location.Row -1 \'运行这里也出错
    
      
  Wb.save()

\'App.Quit


778899:
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:000封面目录备考表fmmlbkb.xls

[此贴子已经被作者于2019/3/18 13:43:39编辑过]

--  作者:hpbcfmqr
--  发布时间:2019/3/18 16:51:00
--  
If Sht.HPageBreaks(iii).Location.Row > nqx + 2 Then Exit For \'获取此页行号,运行这里出错

应该就是Location.Row 出错

--  作者:有点甜
--  发布时间:2019/3/18 17:51:00
--  

 

我测试你的代码没问题,请说明报什么错。

 


--  作者:hpbcfmqr
--  发布时间:2019/3/18 19:25:00
--  
图片点击可在新窗口打开查看无效索引。 (异常来自 HRESULT:0x8002000B (DISP_E_BADINDEX))
--  作者:hpbcfmqr
--  发布时间:2019/3/18 19:30:00
--  

图片点击可在新窗口打开查看此主题相关图片如下:错误信息.jpg
图片点击可在新窗口打开查看

--  作者:hpbcfmqr
--  发布时间:2019/3/18 19:54:00
--  
可以了,自己解决了
--  作者:hpbcfmqr
--  发布时间:2019/3/19 0:46:00
--  
老师,还是没有解决,用下面的方式操作后保存的excel表格,运行上面的代码就会出错,否则就不会出错,求解决
Dim Book As New XLS.Book(ddj)

Dim msheet As XLS.Sheet=Book.Sheets(jnml) \'卷内目录


--  作者:hpbcfmqr
--  发布时间:2019/3/19 0:48:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:000封面目录备考表fmmlbkb.xls


--  作者:hpbcfmqr
--  发布时间:2019/3/19 9:41:00
--  
老师,请帮解决
--  作者:有点甜
--  发布时间:2019/3/19 11:03:00
--  

1、没看懂你这段代码的目的,特别是最后。如果需要打印,直接把有效区域全部打印即可啊;

 

2、HPageBreaks.Count是excel的bug,需要切换到打印预览模式,才能得到准确的值的,如,加入如下代码

 

app.ActiveWindow.view = 2

 

整体代码如下

 

Dim ddj As String="c:\\test.xls"
Dim App As New MSExcel.Application
App.Visible = True


Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(ddj)


Dim sheet As MSExcel.WorkSheet = Wb.WorkSheets("卷内目录")

 


Sheet.PageSetup.PrintArea = ""

Dim nqx As Integer

For nqx = 0 To 1500
   
   
    If Sheet.Cells(3 + nqx, 4).Value = "" And _
        Sheet.Cells(4 + nqx, 4).Value = "" And _
        Sheet.Cells(5 + nqx, 4).Value = "" Then
       
       
        Exit For
    End If
   
   
Next nqx

 


Dim  hhu As  String = "A3:G" & nqx + 2


Sheet.Range(hhu).Rows.AutoFit

Dim sb As Integer


For sb = 0 To nqx + 2 + 15
   
   
   
   
    Dim mm As String = 3 + sb & ":" & 3 + sb
   
    If Sheet.Rows(mm).RowHeight < 42.75 Then
       
        Sheet.Rows(mm).RowHeight = 42.75
       
    End If
   
    3377:
   
   
Next sb

 

 

Dim pages

Dim Rg As MSExcel.Range = Sheet.Cells

Dim HBreaks


Dim  NumPages


Dim Rng As  MSExcel.Range
Dim Sht As   MSExcel.WorkSheet = Sheet

app.ActiveWindow.view = 2
\'计算总页数
HBreaks = Sht.HPageBreaks.Count

NumPages = (HBreaks + 1)


\'计算某单元格的当前页
Rng = Sheet.Cells(2 + nqx, 4)

 

Dim iii As  Integer

For iii = 1 To HBreaks
    If Sht.HPageBreaks(iii).Location.Row > nqx + 2 Then Exit For \'获取此页行号,运行这里出错
Next


Sheet.PageSetup.PrintArea = "$A$1:$G$" & Sht.HPageBreaks(iii).Location.Row -1 \'运行这里也出错


Wb.save()