ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1006|回复: 5

VBA创建窗体超链接中的类定义

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-10-27 09:41 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
诸位大神,请见图 image.png
首先这个窗体出现的信息能否更改为如下,其中的PLAN date是WD date,请问如何更改为MC date.另外想把后面几个黄色的三个状态也添加到窗体是否可行。

VBA只了解一点点,这个是工作当中要用到的, 红色部分是不明白这个PLAN 是怎么定义的。请大神们帮帮忙,不胜感激



整个代码如下:
Option Explicit
Option Private Module
Public skydate As Range
Public axisy As Integer
Public interval As Long
Public skyrange As Range
Public skycell As Range
Public plan As Range
Public y As Integer
Public fs As Integer
Sub setarea()
Dim rangedate As Range
Dim rangearea As Range
On Error Resume Next
Set rangedate = Application.InputBox(Prompt:="Please Select Timeline Columns", Title:="Range Date", Default:=ActiveWorkbook.Names("skylinedate").RefersTo, Type:=8)
ActiveWorkbook.Names("skylinedate").RefersToR1C1Local = rangedate
Set rangearea = Application.InputBox(Prompt:="Please Select Skyline Chart Area", Title:="Range Chart Area", Default:=ActiveWorkbook.Names("skylinearea").RefersTo, Type:=8)
ActiveWorkbook.Names("skylinearea").RefersToR1C1Local = rangearea
End Sub

Sub generate()

With Range("skylinearea")
    .Clear
    .Interior.Color = Range("skylineareabg").Interior.Color
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = Range("skylineareabg").Offset(0, 1).Interior.Color
    End With
End With
On Error Resume Next
For Each skydate In Range("skylinedate")
    interval = skydate - skydate.Offset(0, -1)
    If Err.Number > 0 Then
        interval = skydate.Offset(0, 1) - skydate
    End If
    Err.Clear
    axisy = Range("skylinearea").Rows(Range("skylinearea").Rows.Count).Columns(1).Row
    For y = 1 To Range("listplan").Rows.Count
        Set plan = Range("listplan").Rows(y)
        Set skycell = Sheet1.Cells(axisy, skydate.Column)
        If ActiveSheet.Shapes("check2").ControlFormat.Value = 1 And Range("listcomp").Rows(y).Value = "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("listsystem").Rows(y)
                axisy = axisy - 1
                Call formatting
            End If
        End If
        If Range("listcomp").Rows(y).Value <> "OK" Then
            If plan <= skydate And plan > (skydate - interval) Then
                skycell = Range("listsystem").Rows(y)
                axisy = axisy - 1
                Call formatting
            End If
        End If
    Next
Next
Range("skylinearea").Select
End Sub
Sub formatting()
fs = Range("fontsize").Value
With skycell
    .Hyperlinks.Add anchor:=skycell, Address:="", SubAddress:=skycell.Address, ScreenTip:="Click for more detail"
    .Interior.Color = Range(Range("liststatus").Rows(y)).Interior.Color
    .Interior.Pattern = Range(Range("liststatus").Rows(y)).Interior.Pattern
    .Interior.PatternColor = Range(Range("liststatus").Rows(y)).Interior.PatternColor
    .Font.Color = Range(Range("liststatus").Rows(y)).Font.Color
    .Font.Underline = xlUnderlineStyleNone
    .Font.Bold = True
    .Font.Size = fs
    .WrapText = True
    .HorizontalAlignment = xlCenter
    With .Borders
        .LineStyle = xlContinuous
        .Color = Range(Range("liststatus").Rows(plan.Row - Range("liststatus").Row + 1)).Offset(0, 1).Interior.Color
    End With
End With
End Sub
Sub refresh()
Dim x As ListObject

For Each x In ActiveSheet.ListObjects
    x.AutoFilter.ShowAllData
Next
End Sub


image.png

New Microsoft Excel Worksheet (5).zip

149.06 KB, 下载次数: 1

TA的精华主题

TA的得分主题

发表于 2020-10-27 12:15 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

看不懂你的业务逻辑,如果要修改窗体,应该从是下面的代码入手
'VBA/sysdetail'
模块
For Each s In Range("listsystem")
    If InStr(1, x, s, vbTextCompare) > 0 Then          sysname.Caption = Selection                    sysdesc.Caption = s.Offset(0, 1).Value
      Rem 下面这句应该就是窗体标签赋值语句,可以试试修改 等号 右边为你要显示的值
  ECCdate.Caption = Format(Range("listpla
n").Rows(s.Row - Range("listplan").Row + 1), "D
D-MMM-YYYY")

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-10-27 15:36 | 显示全部楼层
对,就是修改窗体标签,我想知道这个listplan 是如何赋值的,plan的值目前是对应表格中C列,1.如何修改plan的范围,。2.如何添加额外的标签显示,额外再添加其他列的日期值?
请大神指教

New Microsoft Excel Worksheet (5).zip

149.06 KB, 下载次数: 1

TA的精华主题

TA的得分主题

发表于 2020-10-27 17:29 来自手机 | 显示全部楼层
本帖最后由 zpy2 于 2020-10-27 18:07 编辑
Echowang133 发表于 2020-10-27 15:36
对,就是修改窗体标签,我想知道这个listplan 是如何赋值的,plan的值目前是对应表格中C列,1.如何修改plan ...


ActiveWorkbook.Names("skylinearea").RefersToR1C1Local = rangearea

这个就是给 选择 的区域定义 名称。
你把光标放到 Names这个关键词,然后 f1看看吧。或者 百度一下 vba workbook.names
Set plan = Range("listplan").Rows(y)
Stop
这里打个断点,本地窗口看看,应该是个区域

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-10-28 13:09 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-1-9 10:29 | 显示全部楼层
老师,我已经查出来这个区域了,我现在想用更改区域如何做呢?因为在上文的代码中就直接使用一个别名引用了,没找到定义过程。。。
另外关于.Interior.Color = Range(Range("liststatus").Rows(y)).Interior.Color,这句当中的status,当前是使用status+个位数字来定义的,如果超过个位如Status10/或者其他数值就无法实现了,这里又如何修改呢,
请老师指教!不胜感激!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-22 12:23 , Processed in 0.043489 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表