普京网址 24

2、普京网址:为窗体编写VBA代码,我们以此为例实现抓取该表格至Excel中

问题:在平时工作中会遇到,知道其中一个数据,比如姓名,在表格中输入姓名后,想要自动带出网页中该姓名对应的相关数据,比如该姓名的电话,地址等信息,如何做到呢?

作为世界最优秀的矢量图形设计软件CorelDRAW
X3(最新版)居然没有查询图形周长、面积的功能,然而作为矢量图形设计软件,查询图形几何属性是必不可少的,还好有VBA,给了我们扩展
CorelDRAW
X3功能的无限空间,以下就是查询矢量图形几何信息的VBA过程。如果你有Corel
Designer 12,  
可以在里面找到此功能,将其中的窗体,模块,类模块,导出,再到 CorelDRAW
X3 VBA中,把它们导过来,运行“宏”就可以在CorelDRAW
X3中运行了,如果没有请看下面宏代码编写过程。

‘File下载文件相关函数申明
Private Declare Function URLDownloadToFile Lib “urlmon” Alias
“URLDownloadToFileA” (ByVal pCaller As Long, ByVal szURL As String,
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As
Long) As Long
Public Declare Function DeleteUrlCacheEntry Lib “wininet” Alias
“DeleteUrlCacheEntryA” (ByVal lpszUrlName As String) As Long

    
Excel中的许多对象都可以响应事件,这其中包括了Excel程序自身的事件,也包括了我们在Excel中开发VBA应用程序时在对象上所附加的事件处理程序,如按钮的响应事件、单元格被选中的事件、工作表被激活的事件等。大多数的事件处理程序我们都耳熟能详,本文在此重点介绍一下Excel中的图表事件。

回答:

1、启动CorelDRAW X3,新建“图形1”,按“Alt+F11”打开Visual
Basic编辑器,添加如下图所示用户窗体,名称为“frmGeometric”:普京网址 12、为窗体编写VBA代码,窗体代码全部如下:

列出所有工作薄的 VBA

Sub 批量下载()
自动下载导入 (0)
End Sub

在Excel中如何快速地创建图表

Excel抓取并查询网络数据可以使用“获取和转换”+“查找引用函数”的功能组合来实现。

Option Explicit

由 Mr Colo写的 VBA 需要在VBA内选取 Microfost Visual Basic Applications
Extensbility

Sub 下载导入()
关闭功能
自动下载导入 (1)
开启功能
End Sub

   
虽然Excel可以接受任何类型和格式的数据,但是为了方便创建图表,我们通常都会创建一个相对连续的数据区域,并给定一些有意义的值,好的数据组织将有利于生成更加完美的图表。这里有一个例子,分别对A、B、C、D、E五个栏目按Alpha和Beta两种类别进行统计。

例:下图是百度百科“奥运会”网页中的一个表格,我们以此为例实现抓取该表格至Excel中,并且能够通过输入第几届来查询对应的举办城市。

Private CurUnit As Long
Private Lang As New clsLang
Private bPerimeter As Boolean
Private bValidSelection As Boolean
Private bValidArea As Boolean
Private vDepth As Double

请在 Tools – 宏 – 安全性 – 选取 信任存取 Visual Basic 项目

Sub 自动下载导入(Optional dr)
If IsMissing(dr) Then dr = 1 ‘为加了Optional的可选择性省略参数设定值
‘感谢您查看本表源码,本源码和设计模式为本人原创,开源供交流学习,
有疑问可以联系我gzlinwancheng@jd.com
13570972484

‘2016年11月25日
用通过查看会话关闭后失效的Cookie找到库存查询秘钥sso.jd.com设计出查ERP库存表格
‘2016年11月26日
用ERP账号密码Post成功,设计出新的查库存与查订单站点表格给质控客服使用
‘2016年11月28日 成功用Post后的Cookie打开JA表格
‘2016年11月29日 成功用Post后的Cookie下载JA表格,分享
‘2016年12月10日 休息日加班,增加批量导入等制作自动表的代码
‘2016年12月11日 以日报举例,增加时间记录,合并下载和导入两部分代码
‘2016年12月12日
完成WSG库房管家、SRM供应商预约系统Post导入,并调整Post/Get参数到表中设置
‘2016年12月18日
下载地址参数用绝对引用$,以免复制粘贴到不同行时变化,增加说明
‘2016年12月20日
编写Post下载地址获取说明,更改保存路径公式Cell函数增加参数以免选定其他表时地址变化
‘2017年01月22日
增加File下载、手动导入、导入到已有指定列、导入并填充左右相邻公式(无需填充的不要相邻)、

CSV导入使用数据导入并只在第一次自动调整裂开,第二行大于15位的列自动设置文本避免数据丢失
‘ 取消兼容按钮放其他表,界面表名可修改可多账号
‘ 时间提示改进,找不到对应列不导入以防公式表被破坏

快过年了仍把昨天休息和今晚加班用来写代码,京东价值观与程序员的自我修养哈哈哈
‘2017年02月01日 手动导入增加多文件支持
‘2017年02月08日 csv文件导入时清除原列内容,删除查询定义连接
‘2017年02月28日 实现WMS数据自动抓取
‘by 京东商城广州亚洲一号小件库 仓储质控部 园区质控岗 林万程

普京网址 2  
在Excel中生成图表非常简单,选中上述单元格区域,选择Insert选项卡中Charts部分的图表类型,Excel会自动按照你所选的图表类型为你生成图表,如下图。

普京网址 3

Private vLength As Double
Private vArea As Double

‘ Module
‘ List All VBA module
Dim x As Long
Dim aList()

ssh = ActiveSheet.Name '为了兼容按钮放到其他表中

普京网址 4

Step1:使用“获取和转换”功能将网络数据抓取至Excel中

依次点击“数据选项卡”、“新建查询”、“从其他源”、“从Web”。

普京网址 5

弹出如下窗口,手动将百度百科“奥运会”的网址复制粘入URL栏,并点击确定。

普京网址 6

Excel与网页连接需要一定时间,稍等片刻后会弹出如下窗口,左边列表中的每个Table都代表该网页中的一个表格,挨个点击预览后发现,Table3是我们所需的数据。

普京网址 7

点开下方的“加载”旁边的下拉箭头,选择“加载到”。

普京网址 8

在弹出的窗口中,在“选择想要在工作薄中查看此数据的方式”下选择“表”,并点击加载。

普京网址 9

如图,网页表格中的数据已被抓取至Excel中。

普京网址 10

依次点击“表格工具”、“设计”,将“表名称”改为奥运会。

普京网址 11

Private WithEvents cPrecision As clsIntSpin

Sub GetVbProj()
Dim oVBC As VBIDE.VBComponent
Dim Wb As Workbook
x = 2
For Each Wb In Workbooks
For Each oVBC In Workbooks(Wb.Name).VBProject.VBComponents
If Workbooks(Wb.Name).VBProject.Protection = vbext_pp_none Then
Call GetCodeRoutines(Wb.Name, oVBC.Name)
End If
Next
Next
With Sheets.Add
.[A1].Resize(, 3).Value = Array(“Workbook”, “Module”, “Procedure”)
.[A2].Resize(UBound(aList, 2), UBound(aList, 1)).Value = _
Application.Transpose(aList)
.Columns(“A:C”).Columns.AutoFit
End With
End Sub

‘ Sheets(“界面”).Select ‘为了兼容按钮放到其他表中

     选择Design选项卡,在Chart
Layouts部分选择不同的布局,可以丰富图表的内容,如添加图表的名称、设置图例的显示位置等。通过Excel提供的图表功能,我们可以给图表添加许多元素,按照
Excel自带的说明文档上的介绍,一个相对较完整的图表应该包含7个单元。

Step2:使用“查找与引用”函数实现数据查询

建立查询区域,包含“届数”和“主办城市”,在届数中随意选取一届输入,下图输入“第08届”,在主办城市下输入vlookup函数,可以得到第08届奥运会的主办城市是巴黎,当更改届数时,对应的主办城市也随之变动。

公式:=VLOOKUP([届数],奥运会[#全部],4,0)

普京网址 12

注意点:若网页中的数据变动较频繁,则可以设置链接网页的数据定时刷新:

①将鼠标定位于导入的数据区域中,切换到选项卡,点击下拉箭头→

普京网址 13

②在弹出的对话框中,设置,比如设置为10分钟进行刷新。这样,每隔10分钟数据就会刷新一次,时刻保证获取的数据位最新的。

普京网址 14


style=”font-weight: bold;”>「精进Excel」系头条签约作者,关注我,如果任意点开三篇文章,没有你想要的知识,算我耍流氓!

回答:

大家好,我是@Excel实例视频网站长@欢迎私信或者邀请我回答Excel相关问题!


有人在群里问手机号怎么批量查归属地,第一感觉是百度一下,结果还真没找到好用的,既然如此,我就自己写一个吧!首先找了几个webapi,找到个挺好用的,就用vba写了个自定义函数,测试下感觉还是挺好用,速度也挺快

普京网址 15

style=”font-weight: bold;”>源文件下载链接请私信回复63005即可

使用方法:

1.在本表中直接在A1列输入手机号即可

2.要在其他表中,alt+f11打开vbe编辑器,复制模块中代码,在你的新表中建立模块,粘贴代码即可

3.函数参数说明

GetPhoneInfo(号码,参数)

号码—即单个手机号

参数(1,2,3,4):1-城市,2-省,3-运营商, 4-全部

代码如下

Dim ObjXML As Object

Function GetPhoneInfo(number, Optional para As Byte = 1)

‘获取手机号对应的基本信息 默认为城市

‘para:1-城市,2-省,3-运营商,4,全部

Dim s As String

s =
GetBody(“”
& number)

Select Case para

Case 1

GetPhoneInfo = HtmlFilter(s, “City””:”””, “”””)

Case 2

GetPhoneInfo = HtmlFilter(s, “Province””:”””, “”””)

Case 3

GetPhoneInfo = HtmlFilter(s, “TO””:”””, “”””)

Case 4

GetPhoneInfo = HtmlFilter(s, “City””:”””, “”””) & “,” & HtmlFilter(s,
“Province””:”””, “”””) & “,” & HtmlFilter(s, “TO””:”””, “”””)

End Select

GetPhoneInfo = Replace(GetPhoneInfo, ” “, “”)

End Function

Private Sub Test()

Dim i&, j&, k&, arr, brr

url =
“”

Debug.Print GetBody(url)

End Sub

”’如果出现乱码,UTF-8可改为GB2312

Public Function GetBody(ByVal url$, Optional ByVal Coding$ = “utf-8”)

On Error Resume Next

Set ObjXML = CreateObject(“Microsoft.XMLHTTP”)

With ObjXML

.Open “Get”, url, False, “”, “”

‘.setRequestHeader “If-Modified-Since”, “0”

‘.setRequestHeader “User-Agent”, _

“.Mozilla/5.0 (Windows NT 6.1; WOW64; rv:47.0) Gecko/20100101
Firefox/47.0”

.Send

GetBody = .ResponseBody

End With

GetBody = BytesToBstr(GetBody, Coding)

Set ObjXML = Nothing

End Function

Public Function BytesToBstr(strBody, CodeBase)

Dim ObjStream

Set ObjStream = CreateObject(“Adodb.Stream”)

With ObjStream

.Type = 1: .Mode = 3: .Open:

.Write strBody: .Position = 0: .Type = 2: .Charset = CodeBase

BytesToBstr = .ReadText: .Close

End With

Set ObjStream = Nothing

End Function

Public Function HtmlFilter(ByVal htmlText$, ByVal Label1$, ByVal
label2$)

‘返回html字符串lable1和最近的lable2标签中的数据

Dim pStart As Long, pStop As Long

pStart = InStr(htmlText, Label1) + Len(Label1)

If pStart <> 0 Then

pStop = InStr(pStart, htmlText, label2)

HtmlFilter = Mid(htmlText, pStart, pStop – pStart)

End If

End Function

回答:

专业的人做专业事情。

Private Sub OnUnitChange(ByVal Unit As Long)
    Dim strLength As String
    Dim strArea As String
    Dim strVolume As String
   
    vDepth = Application.ConvertUnits(vDepth, GetAppUnits(CurUnit),
GetAppUnits(Unit))
    CurUnit = Unit
    UpdateDepth
   
    strLength = GetCurUnitString()
    lblUnitLength.Caption = strLength
    lblUnitArea.Caption = strLength & GetSquare(False)
    lblUnitDepth.Caption = strLength
    lblUnitVolume.Caption = strLength & GetCube(False)
   
    UpdateValues
End Sub

Private Sub GetCodeRoutines(wbk As String, VBComp As String)
Dim VBCodeMod As CodeModule
Dim StartLine As Long

ri = 5
 

1. 图表显示区域。

2. 数据透视图区域。

3. 数据透视图中用于显示数据图表的数据点。

4. 数据透视图中的坐标值。

5. 图例区域。

6. 图表的标题。

7. 用于作为tooltip的数据标签,对数据的解释。

如果只是偶尔有这个任务,还是在网上出点钱,找人做了。

花费的钱真的不多。几百元足够了。

Private Sub UpdateDepth()
    Updating = Updating + 1
    txtDepth.Text = CStr(vDepth)
    Updating = Updating – 1
End Sub

On Error Resume Next
Set VBCodeMod =
Workbooks(wbk).VBProject.VBComponents(VBComp).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
ReDim Preserve aList(1 To 3, 1 To x – 1)
aList(1, x – 1) = wbk
aList(2, x – 1) = VBComp
aList(3, x – 1) = .ProcOfLine(StartLine, vbext_pk_Proc)
x = x + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc), vbext_pk_Proc)
If Err Then Exit Sub
Loop
End With
Set VBCodeMod = Nothing
End Sub

‘ 联网提示
(“http://ssa.jd.com/sso/login”)

   
按照上述方法创建的图表默认是嵌套在Excel工作表中的,我们也可以创建一个独立的图表在Excel中指定的地方显示。在Design选项卡中找到Location部分,选择Move
Chart,弹出的对话框如下图所示,选择New
sheet,并定义一个有意义的名称,点击OK,此时Excel会在一个新的sheet中创建图表。这里有一个快速创建图表的方法,选中要创建图表的单元格区域,直接按F11,Excel会按照默认的选项在新的sheet中生成图表。在新
sheet中生成的图表可以在VBA中作为对象来进行访问,同时也可以编写事件处理程序,稍后会介绍。

如果是平时任务多,且有一定的基础,学习一下未必不可。

老猫是通过VBA操作的,写一个代码,抓取数据,也很方便。

老猫正在开发的一款足彩软件程序救市从网上抓取大量数据。然后分析和预测足彩。

Private Function GetCurUnitString() As String
    Dim strLength As String
    Select Case CurUnit
        Case 0
            strLength = Lang.GetString(eUnitInch)
        Case 1
            strLength = Lang.GetString(eUnitMM)
        Case 2
            strLength = Lang.GetString(eUnitCM)
        Case 3
            strLength = Lang.GetString(eUnitM)
    End Select
    GetCurUnitString = strLength
End Function

不可以选择或编辑单元格

Set http = CreateObject("Msxml2.ServerXMLHTTP")
    '登录
    http.Open "post", "http://ssa.jd.com/sso/login", False
    http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    Data = "username=" & [B2] & "&password=" & [B3] & "" '【ERP账号密码所在位置】
    http.send (Data)

    If InStr(http.responsetext, "登录超时") > 0 Then
        tip = Time & " 登录超时,ERP账号密码错误或未填写。"
        Debug.Print tip
        MsgBox tip
        End
    End If

'下载
For ri = 5 To [H1048576].End(xlUp).Row
If Range("B" & ri) <> "" Then '用下载表名判断,不导入的可以不填表名,这样不用去掉网址
    t1 = Time
    '报表下载保存地址
    ph = Range("A" & ri)
    If ph = "" Then ph = ThisWorkbook.path
    fn = ph & "\" & Range("B" & ri) & "." & Range("F" & ri)
    If Range("G" & ri) = "File" Then
        lngRetVal = URLDownloadToFile(0, Range("H" & ri), fn, 0, 0)
        If lngRetVal = 0 Then DeleteUrlCacheEntry Range("H" & ri)
    ElseIf Range("G" & ri) = "WMS" Then
        sq = [H1]
        sqt = Range("H" & ri)
        Workbooks.Add
        With ActiveSheet
        With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
            "ODBC;DRIVER={MySQL ODBC 5.3 Unicode Driver};" & sq, _
            Destination:=.Range("A1")).QueryTable
            .CommandText = sqt
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells '插入模式=覆盖(还有插入行和插入列选择)f
            .SavePassword = True '保存密码
            .SaveData = True
            .AdjustColumnWidth = Ture
            .RefreshPeriod = 0 '刷新频率单位秒,0不自动刷新
            .PreserveColumnInfo = True
            .ListObject.DisplayName = "万程的缩写是WC"
            .Refresh BackgroundQuery:=False
            .Delete '删除查询定义
        End With
        End With
        ActiveWorkbook.SaveAs FileName:=fn, FileFormat:=xlCSV, CreateBackup:=False
        ActiveWindow.Close
    Else
        http.Open Range("G" & ri), Range("H" & ri), False
        http.send ("")
        DoEvents '防止程序假死

        Debug.Print attfn(http)

普京网址 16

这是抓取的比赛列表:

普京网址 17

Private Function GetSquare(ByVal bUnicode As Boolean) As String
    Dim s As String
    s = ChrW$(178)
    If Not bUnicode And Asc(s) = 63 Then
        s = “2”
    End If
    GetSquare = s
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Myrange As Range, KeepOut As Range
Dim ws As Worksheet

‘ If InStr(http.responsetext, “not support”) > 0 Then
‘ tip = Time & ” ” & Range(“B” & ri) & ”
方法错误,请在网页中登录后运行,或更换有权限账号。”
‘ Debug.Print tip
” MsgBox tip
‘ Else

普京网址 18 

这是VBA程序代码

普京网址 19

Private Function GetCube(ByVal bUnicode As Boolean) As String
    Dim s As String
    s = ChrW$(179)
    If Not bUnicode And Asc(s) = 63 Then
        s = “3”
    End If
    GetCube = s
End Function

‘Full sheet
‘Set KeepOut = ActiveSheet.Cells
‘Several Columns
‘Set KeepOut = ActiveSheet.Range(“B:D”)
‘Test Range
Set KeepOut = ActiveSheet.Range(“A2:C5”)

        Set sGet = CreateObject("ADODB.Stream") '下载文件
            sGet.Mode = 3
            sGet.Type = 1
            sGet.Open
            sGet.Write (http.responseBody)
            sGet.SaveToFile SaveTo & fn, 2

为什么要使用图表事件

这是抓取的赔率数据

普京网址 20

总之,如果想学是不难的。

回答:

以EXCEL2003为例来给你说明。

一、首先打开EXCEL2003,在菜单栏找到“数据”然后在下拉菜单点击“导入外部数据-新建WEB查询”
普京网址 21
二、然后在打开的对话框中的地址栏中,将你要导入的网址输入进去,按下转到按钮。
普京网址 22
三、在弹开的对话框中原则需要导入的区域,按下导入按钮,这个时候,数据就被导入到EXCEL里面啦!
普京网址 23最后,你的电脑得链接网络,要不没有数据,这样导入的好处是,可以和网站上保持一致,无需进行手动更新,很方便。

Private Sub cArea_Click()
    UpdateControls
End Sub

Set Myrange = Intersect(Target, KeepOut)
‘Leave if the intersecttion ws untouched
If Myrange Is Nothing Then Exit Sub

‘ Set sGet = Nothing ‘清除文件流

   
使用图表事件可以更加方便用户使用我们编写的VBA应用程序。例如,我们可以给图表添加一个select事件,当用户点击图表数据透视图中的数据点时,为用户做这样一些事情:

Private Sub cboUnits_Change()
    OnUnitChange cboUnits.ListIndex
End Sub

‘Stop select firing a second time
Application.EnableEvents = False
If KeepOut.Rows.Count = 65536 And KeepOut.Columns.Count = 256 Then
‘Entire sheet is the KeepOut range. Eek!
‘Bounce user to a dummy sheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(“KickMeTo”)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Sheets.Add
ws.Name = “KickMeTo”
End If
MsgBox “Houston we have a problem” & vbNewLine & _
“You cannot select any cell in ” & vbNewLine & “‘” & KeepOut.Parent.Name
& “‘” & vbNewLine & _
“So you have been directed to a different sheet”
ws.Activate
ElseIf KeepOut.Rows.Count = 65536 Then
‘If all rows are contained in the “KeepOut” range then:
‘Now we need to find a cell that is in a column to the right or left of
this range
If KeepOut.Cells(1).Column > 1 Then
‘If there is a valid column to the left of the range then select the
cell in this column
Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column – 1).Select
Else
‘Else select the cell in first column to the right of the range
Cells(KeepOut.Cells(1).Row, KeepOut.Cells(1).Column + 1).Select
End If
MsgBox “You cannot select ” & KeepOut.Address(False, False) & vbNewLine
& _
“You have been directed to the first free column in the protected
range”, vbCritical
ElseIf KeepOut.Rows.Count + KeepOut.Cells(1).Row – 1 = 65536 Then
‘Select first cell in Column A before “KeepOut” Range
Cells(KeepOut.Cells(1).Row – 1, 1).Select
MsgBox “You cannot select ” & KeepOut.Address(False, False) & vbNewLine
& _
“You have been directed to the first free cell in Column A above the
protected range”, vbCritical
Else
‘Select first cell in Column A beyond “KeepOut” Range
MsgBox “You cannot select ” & KeepOut.Address(False, False) & vbNewLine
& _
“You have been directed to the first free cell in Column A below the
protected range”, vbCritical
Cells(KeepOut.Rows.Count + KeepOut.Cells(1).Row, 1).Select
End If
Application.EnableEvents = True
End Sub

‘ End If

  • 显示一个提示信息
  • 提取图表中的信息并放置到工作表中。
  • 激活另外一个图表或工作表。
  • 识别一个数据点进行数据分析。

Private Sub cLength_Click()
    UpdateControls
End Sub

MicroSoft 沒有文件顯示 編碼 的大小限制
64K 太大,很難跟進

        Application.ScreenUpdating = True '启用屏幕更新
        Range("E" & ri).Select '显示进度
        Application.ScreenUpdating = False '禁用屏幕更新
        If tip = Empty Then
            Range("E" & ri) = Time - t1
        Else
            Range("E" & ri) = tip
        End If
    End If

    '导入
    If dr = 1 Then
    If Range("C" & ri) <> "" Then '用导入表名判断,不导入的可以不填表名,这样不用去掉网址
    If Dir(fn, 16) <> Empty Then '路径不存在不运行,这里不加的话kill fn会报错
        s = Range("C" & ri)
        tip = 导入表(fn, s)
        Kill fn '删除文件

        Sheets(ssh).Select '打开导入过程选定表会变化,所以重新选定
        Application.ScreenUpdating = True '启用屏幕更新
        Range("E" & ri).Select '显示进度
        Application.ScreenUpdating = False '禁用屏幕更新
        If tip = Empty Then
            Range("E" & ri) = Time - t1
        Else
            Range("E" & ri) = tip
        End If
    End If
    End If
    End If
End If
Next

   
在接下来的内容中,我会向大家介绍Excel中图表对象的一些常用事件的使用方法,并会给出相应的示例。

Private Sub cmClose_Click()
    Unload Me
End Sub

以下編碼檢示 Module 的大小

‘ Sheets(ssh).Select ‘为了兼容按钮放到其他表中
End Sub

 

Private Sub cmCopy_Click()
    Dim sData As String
    Dim oData As New DataObject

Sub get_Mod_Size()
Dim myProject As Object
Dim ComName As String
Dim tempPath As String
Dim fs As Object, a As Object
Dim result As String

Function decodeURI(szInput)
Set js = CreateObject(“MSScriptControl.ScriptControl”)
js.Language = “JScript”
decodeURI = js.Eval(“decodeURI(‘” & szInput & “‘)”)
End Function

如何添加图表事件

    sData = GetDataString(False)
    If sData <> “” Then
        oData.SetText sData
        oData.PutInClipboard
    End If
End Sub


**************************************************************************************
‘ Use this to determine the size of a module
‘ Set ModName (component name) and tempPath (where to store the temp
fule), then run

**************************************************************************************

Function attfn(http)
attfn =
Replace(decodeURI(http.getResponseHeader(“Content-Disposition”)),
“attachment;filename=”, “”)
End Function

   
与其它的VBA控件类似,要想为图表对象添加事件,必须首先进入到Excel的Visual
Basic
编辑器。在上图中,右键点击Chart4选项卡(在Excel窗体的下端),选择“View
Code”,即可打开 Visual
Basic编辑器。或者在“开发工具”选项卡中直接点击Visual
Basic按钮。如果是从当前图表所在的标签进入的Visual Basic编辑器,则Visual
Basic编辑器窗口中默认打开的是当前图表的Code窗体,在Code窗体的顶部有两个下拉列表,在左边的下拉列表中选择Chart,右边的下拉列表中即显示了Chart对象支持的所有事件名称,默认是Active事件,即Chart被激活时所触发的事件。

Private Sub cmCreateText_Click()
    Const TextSize As Double = 24 ‘ 24 pt text
    Dim lr As Layer
    Dim sData As String
    Dim sr As ShapeRange
    Dim x As Double, y As Double, w As Double, h As Double
    sData = GetDataString(True)
    Updating = Updating + 1
    If Not ActiveShape Is Nothing And sData <> “” Then
        Set sr = ActiveSelectionRange
        ActiveShape.GetBoundingBox x, y, w, h
        x = x + w / 2
        y = y – ActiveDocument.ToUnits(TextSize, cdrPoint)
        Set lr = ActiveShape.Layer
        If lr.Editable Then Set lr = ActiveLayer
        lr.CreateArtisticText x, y, sData, cdrEnglishUS, , “Times New
Roman”, 24, cdrTrue, cdrTrue, , cdrLeftAlignment
        sr.CreateSelection
    End If
    Updating = Updating – 1
End Sub

‘ Set these to run
ComName = “Module1”
tempPath = “c:\Test.bas”

Function 表存在(s)
For Each i In Sheets
If i.Name = s & “” Then 表存在 = 1
‘连接空白是避免表格名为数值时格式不同
‘ Debug.Print i.Name = s
Next
End Function

普京网址 24

Private Sub cmRefresh_Click()
    RefreshForm
End Sub

‘ ***** No action needed after this point *****

Function 建表(s)
For Each i In Sheets
If i.Name = s Then Exit Function
Next
Sheets.Add(, ThisWorkbook.Sheets(Sheets.Count)).Name = s
‘ Sheets.Add.Name = s’创建在前面
‘ Sheets.Add 方法
(Excel):https://msdn.microsoft.com/zh-cn/library/office/ff839847
End Function

    Chart对象支持以下这些事件:

Private Sub cmReset_Click()
    vDepth = 0
    UpdateDepth
    UpdateValues
End Sub

‘ Export the component (module, form, etc) – this is only temporary
Set myProject = Application.VBE.ActiveVBProject.VBComponents
myProject(ComName).Export (tempPath)

Sub 更新WMS秘钥()
If 进程命令(“SmartQueryTwo.exe”) <> “” Then
[H1] = Split(进程命令(“SmartQueryTwo.exe”), “,”)(5)
End If
End Sub

  • Active:当Chart对象被激活时触发。
  • BeforeDoubleClick:鼠标双击前触发。
  • BeforeRightClick:鼠标右键单击前触发。
  • Calculate:使用公式运算时触发。
  • Deactivate:当Chart对象释放激活状态时触发。
  • DragOver:当Chart对象被拖动时触发。
  • DragPlot:当Chart对象中的数据透视图被拖动时触发。
  • MouseDown:鼠标按下时触发。
  • MouseMove:鼠标移动时触发。
  • MouseUp:鼠标按下,然后松开按键时触发。
  • Resize:调整Chart的大小时触发。
  • Select:Chart中的对象被选择时触发。
  • SeriesChange:改变Chart中的图标系列时触发。

Private Sub cPrecision_Change()
    UpdateValues
End Sub

‘ Get the size of the file created
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set a = fs.getfile(tempPath)
result = ComName & ” uses ” & (a.Size / 1000) & ” KB.”

Function 测网(url)
On Error Resume Next
cmdping = “ping ” & url & ” -n 1″
Set oExec = CreateObject(“Wscript.shell”).exec(cmdping)
Do Until oExec.stdout.AtEndOfStream
strline = strline & oExec.stdout.readline() & Chr(13)
Loop
测网 = 0
If InStr(strline, “回复”) Then 测网 = 1
Set oExec = Nothing
End Function

    下面我着重介绍几个常用事件的使用方法。

Private Sub cVolume_Click()
    UpdateControls
End Sub

‘ Return the file size
MsgBox result, vbExclamation

Function 联网提示(url)
If 测网(url) = 0 Then
tip = Time & ” 请确认是否连接上公司内网。”
Debug.Print tip
MsgBox tip
End
End If
End Function

 

发表评论

电子邮件地址不会被公开。 必填项已用*标注

相关文章