前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
社区首页 >专栏 >VBA实用小程序:获取工作表每页的地址

VBA实用小程序:获取工作表每页的地址

作者头像
fanjy
发布2023-02-24 20:57:47
发布2023-02-24 20:57:47
83500
代码可运行
举报
文章被收录于专栏:完美Excel完美Excel
运行总次数:0
代码可运行

有时,我们需要知道组成工作表的所有页面的地址。如下图1所示的工作表,由6页组成。

图1

下面的程序列出每页的地址:

代码语言:javascript
代码运行次数:0
运行
复制
Sub MainCode()
   PageAddress True
End Sub
Sub PageAddress(colorcode As Boolean)
    Dim c As Integer
    Dim v As Integer
    Dim h As Integer
    Dim cln As Integer
    Dim rw As Integer
    Dim hgth As Integer
    Dim wth As Integer
    Dim i As Integer
    Dim s As String
    Dim pag()
    Dim ws As Worksheet
    Set ws =ActiveSheet
    c = 1
    s =""
   ActiveWindow.View = xlPageBreakPreview
    ws.PageSetup.PrintArea= ""
   ws.PageSetup.PrintArea = ws.UsedRange.Address
    ReDim Preserve pag(1 To (ws.VPageBreaks.Count + 1) * (ws.HPageBreaks.Count + 1))
    For v = 0 To ws.VPageBreaks.Count
        For h= 0 To ws.HPageBreaks.Count
            If v = ws.VPageBreaks.Count Then
               wth = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
           Else
               wth = ws.VPageBreaks(v + 1).Location.Column - 1
           End If
           If h = ws.HPageBreaks.Count Then
               hgth = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
           Else
               hgth = ws.HPageBreaks(h + 1).Location.Row - 1
           End If
           If v = 0 Then
               cln = 1
           Else
                cln = ws.VPageBreaks(v).Location.Column
           End If
           If h = 0 Then
               rw = 1
           Else
               rw = ws.HPageBreaks(h).Location.Row
           End If
           Set pag(c) = ws.Range(ws.Cells(rw, cln).Address & ":"& ws.Cells(hgth, wth).Address)
            s= s & pag(c).Address & vbLf
           If colorcode Then pag(c).Interior.Color = RGB(CInt(250 * Rnd), CInt(250* Rnd), CInt(250 * Rnd))
            c= c + 1
        Next h
    Next v
    MsgBox s
End Sub

示例运行代码后的结果如下图2所示。

图2

注:本程序整理自www.mrexcel.com,供大家学习参考。

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2023-01-23,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档