老师，请帮忙看看下面代码，有一行不知道怎么都过不了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
[此贴子已经被作者于2019/3/18 13:43:39编辑过]
加好友 
发短信
Post By：2019/3/18 13:41:00 [只看该作者]
