ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索

收集的各类资料

已有 4325 次阅读2014-8-15 19:31 | 资料

一、表格内插入图片并修改大小

1、方式一

Dim photo As Picture
Set photo = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\
学生相片\" & sFile & ".jpg")
With photo
  .Name = sFile
  .ShapeRange.LockAspectRatio = msoFalse
  .Top = rng.Top
  .Left = rng.Left + 15
  .Width = 71
  .Height = 99
End With

2、方式二

Sub zf()
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.DrawingObjects.Delete
Dim i%
Dim MR As Range

For Each MR In Range("C2:h" & 5)
If Not IsEmpty(MR) Then
 MR.Select
 ML = MR.Left + 4
 MT = MR.Top + 4
 MW = MR.Width * 0.9
 MH = MR.Height * 0.9
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
 Selection.ShapeRange.Fill.UserPicture _
 ActiveWorkbook.Path & "\
图片\" & MR.Value &  ".jpg" '当前文件所在目录下以当前单元内容为名称的.jpg图片
End If
Next
Application.ScreenUpdating = True

End Sub

二、ScrollArea 锁屏

A1 样式的区域引用形式返回或设置允许滚动的区域。用户不能选定滚动区域之外的单元格。String 类型,可读写。

说明:
可将本属性设置为空字符串 ("") 以允许对整张工作表内所有单元格的选定。

Excel VBA教程:ScrollArea属性·示例,本示例设置第一张工作表的滚动区域。

Worksheets(1).ScrollArea = "a1:f10"

 

三、VBA commandbars
worksheet menu bar
表示工作表菜单栏,
Application.CommandBars("worksheet menu bar").Enabled = False

formatting表示格式工具栏
Application.CommandBars("Formatting").Visible = False

standard表示常用工具栏
Application.CommandBars("Standard").Visible = falsae

'drawing表示绘图工具栏
Application.CommandBars("Drawing").Visible = False

'control toolbox表示控件工具箱
Application.CommandBars("Control Toolbox").Visible = False

'reviewing表示审阅工具
Application.CommandBars("Reviewing").Visible = False

Application.CommandBars("金山快译").Visible = False

'dispalyformulabar表示编辑栏
Application.DisplayFormulaBar = False

Application.CommandBars("Visual Basic").Visible = False

Application.CommandBars("Web").Visible = False

Application.CommandBars("Protection").Visible = False

Application.CommandBars("Borders").Visible = False

Application.CommandBars("Forms").Visible = False

Application.CommandBars("Formula Auditing").Visible = False

Application.CommandBars("Watch Window").Visible = False

'pivottable表示数据透视表
Application.CommandBars("PivotTable").Visible = False

'chart表示图表
Application.CommandBars("Chart").Visible = False

'picture表示图片
Application.CommandBars("Picture").Visible = False

Application.CommandBars("Exit Design Mode").Visible = False

'external data表示外部数据
Application.CommandBars("External Data").Visible = False

Dim aa, bb As Boolean
aa = True
bb = False
Application.CommandBars("ply").Enabled = aa
'
右键点工作表标签是否可用
Application.CommandBars("cell").Enabled = aa
'
右键点单元格是否可用
Application.CommandBars("toolbar list").Enabled = aa
'
右键点工具栏及视图工具栏是否可用
Application.CommandBars("autocalculate").Enabled = aa
'
右键点状态栏是否可用
Application.CommandBars("worksheet menu bar").Enabled = aa
Application.CommandBars(1).Enabled = aa
'
以上两句的作用都是把菜单取消
Application.CommandBars(2).Enabled = aa
'
暂时未知
Application.CommandBars(3).Enabled = aa
'
常用工具栏是否可用
Application.CommandBars(3).Controls(3).Enabled = aa
'
使常用工具栏中第三个保存是否可用
Application.CommandBars(4).Enabled = aa
'
格式工具栏是否可用
Application.CommandBars(5).Enabled = aa
'
暂时未知
Application.CommandBars(1).Enabled = aa
'
恢复菜单可用
Application.CommandBars(1).Controls(1).Enabled = aa
'
使菜单中的文件是否可用
Application.CommandBars("file").Controls("
页面设置(&U)...").Enabled = aa
'
菜单中的文件中的页面设置是否可用
Application.CommandBars(1).Controls(4).Enabled = aa
'
菜单中的第四个插入是否可用
Application.CommandBars(1).Controls(4).Caption = "victor"
'
更改名称
Application.CommandBars(1).Reset
'
恢复菜单
Application.DisplayFormulaBar = aa
'
编辑栏是否显示
Application.DisplayStatusBar = aa
'
状态栏是否显示
ActiveWindow.DisplayHeadings = aa
'
行号列标是否显示
ActiveWindow.DisplayWorkbookTabs = aa
'
工作表标签是否显示
ActiveWindow.DisplayHorizontalScrollBar = aa
'
水平滚动条是否显示
ActiveWindow.DisplayVerticalScrollBar = aa
'
垂直滚动条是否显示

四、SMALL函数的语法是:SMALL(array,k)

  SMALL函数的参数说明:
  第一,Array:为需要找到第 k 个最小值的数组或数字型数据区域。
  第二,K:为返回的数据在数组或数据区域里的位置(从小到大)。

ExcelSMALL函数和LARGE函数是一对相反的函数,都是属于excel的排名函数,SMALL函数是返回排名从小到大的值,LARGE函数是返回排名从大到小的值。

五、不连续单元格for循环赋值,使用数组

For Each i In Array(1, 2, 7, 8, 12, 15, 19)
Cells(2, i) = Cells(1, i)

Next

六、对宏模块代码的操作

VBProject:代码操作代码之常用语句
一、增加模块

1
.增加一个模块,命名为我的模块

ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "
我的模块
"
系统常量
vbext_ct_StdModule=1
2
.增加一个类模块,命名为我的类

ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "
我的类
"
vbext_ct_ClassModule=2
3
.增加一个窗体,命名为我的窗体

ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = "
我的窗体
"
vbext_ct_MSForm=3
二、删除模块

1
.删除模块
1”
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("
模块
1")
2
.删除窗体
“UserForm1”
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1")

3
.删除类模块
1”
ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("
1")

4.
删除所有的窗体

Sub RmvForms()
Dim vbCmp As VBComponent
For Each vbCmp In ThisWorkbook.VBProject.VBComponents
If vbCmp.Type = vbext_ct_MSForm Then ThisWorkbook.VBProject.VBComponents.Remove vbCmp
Next vbCmp

End Sub
相关:

工作表和ThisWorkbook的模块类型为
vbext_ct_Document=100
三、增加代码

1.
模块1”中插入代码

如果需要在“Sheet1”“Thisworkbook”、或“Userform1”中操作,用只需将下面的模块1”换成相应的名称即可。

方法1

在模块的开始增加代码,增加的代码放在公共声明option,全局变量等后面。

Sub AddCode1()
ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.AddFromString _
"sub aTest()" & Chr(10) & _
"msgbox ""Hello""" & Chr(10) & _
"end sub"
End Sub
方法2

在模块指定行处增加代码,原代码后移。增加代码不理会和判断插入处代码的内容。当指定行大于最后一行行号时,在最后一行的后面插入。

Sub AddCode2()
With ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule
.InsertLines 1, "sub aTest()"
.InsertLines 2, "msgbox ""Hello"""
.InsertLines 3, "end sub"
End With
End Sub

相关语句:

(1)“
模块1”中代码总行数:

ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.CountOfLines
(2)“
模块1”中代码公共声明部分的行数:

ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.CountOfDeclarationLines
(3)
显示模块1”中第1行起的3行代码内容:

Sub ShowCodes()
Dim s$
s = ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.Lines(1, 3)
Debug.Print s
End Sub
(4)
过程aTest的起始行数:

ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc)
ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.ProcStartLine("aTest", 0)
系统常量
vbext_pk_Proc=0
二者的区别是ProcBodyLine返回sub aTestFunction aTest所在的行号,如果sub前面有空行,ProcStartLine返回空行的行号。

(5)
过程aTest的总行数:

ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.ProcCountLines("aTest", vbext_pk_Proc)
2.
建立事件过程

建立事件过程除了使用上面的代码如下面的AddEventsCode1外,还可以使用CreateEventProc方法,如AddEventsCode2所示。

一般方法:

Sub AddEventsCode1()
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _
"Private Sub Workbook_Open()" & Chr(13) & _
"MsgBox ""Hello""" & Chr(13) & _
"End Sub"
End Sub
CreateEventProc
方法:

Sub AddEventsCode2()
Dim i%
With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
i = .CreateEventProc("SelectionChange", "Worksheet") + 1
.InsertLines i, "Msgbox ""Hello"""
End With
End Sub
上面CreateEventProc的两个参数建立的事件过程为Worksheet_SelectionChange,分别是下划线两边的内容。

相关:

测试是否存在SelectionChange事件

下面函数测试模块modulname是否存在过程subname,如果存在,则返回起始行号,否则返回0

debug.print hassub("Worksheet_SelectionChange","Sheet1")
Function HasSub(ByVal subname As String, ByVal modulname As String) As Long
On Error Resume Next
Dim i&
i = ThisWorkbook.VBProject.VBComponents(modulname).CodeModule.ProcBodyLine(subname, 0)
If Err.Number = 35 Then
Err.Clear
HasSub = 0
Else
HasSub = i
End If

End Function

如果存在,则返回起始行号,否则返回0


四、删除代码

1
.删除Sheet1中第2行起的三行代码:

如果只删除1行代码,第二个参数可省略。

Sub DelCodes()
ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.DeleteLines 2, 3
End Sub
2
.删除模块1”的所有代码:

Sub DelCodes()
With ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule
.DeleteLines 1, .CountOfLines
End With
End Sub
3
.删除过程
aTest:
Sub DelCodes()
With ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule
.DeleteLines . ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0)
End With
End Sub
4
.将模块1”的第5行代码替换为
“x=3”
ThisWorkbook.VBProject.VBComponents("
模块
1").CodeModule.ReplaceLine 5, "x=3"
五、引用项目

1
.增加引用

ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\asctrls.ocx"
2
.取消引用

ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls")
这里ASControls是引用的名字,即后面的rf.Name

3
.显示当前所有引用

Sub ShowRefs()
Dim rf As VBIDE.Reference
For Each rf In ThisWorkbook.VBProject.References
Debug.Print rf.Name, rf.FullPath
Next
End Sub
六、信任及密码

上面所有操作都基于这样的前题:

1EXCEL已设置:

工具(T-宏(M-安全性(M-可靠发行商(T-勾选了信任对于VB项目的访问(V

2)工程没有设置密码

如果不能满足它们中的任何一个,代码运行就会出错。因为微软不希望我们对VBProject进行操作,我们无从知道这种操作的直接方法被藏到了什么地方。幸运的是,微软在关起正门的同时,还是为我们留了一道门:SendKeys。借助于这道后门和错误陷阱,我们仍可以完成我们所要做的事。


下面给出绕开这两道门的示意代码,如果你要运行它们,请记得切回EXCEL主界面,而不是在VBE中直接运行。


1
.信任对于VB项目的访问

Sub SetAllowableVbe()
On Error Resume Next
Dim Chgset As Boolean
'
陷阱测试,VBProject.Protection在这儿并无实际的意义

Debug.Print ThisWorkbook.VBProject.Protection
If Err.Number = 1004 Then
Err.Clear
Application.SendKeys "%TMS%T%V{ENTER}"
Chgset = True
DoEvents
End If
'
要执行的操作
....

'.....

'
操作完成后还原操作前的状态


If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"

End Sub
2
.操作密码工程

Sub AllowPass()
Dim pw$

pw = "Password"
If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then
Application.VBE.CommandBars(1).Controls("
工具(T)").Controls("VBAProject 属性
(&E)...").Execute
Application.SendKeys pw & "{ENTER}{ENTER}"
DoEvents
End If
'
要执行的操作
….
End Sub
Protection
属性返回工程的受保护状态,vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。

 

 


路过

鸡蛋

鲜花

握手

雷人

发表评论 评论 (86 个评论)

回复 liulang0808 2018-11-12 18:54
将mPath路径下的所有文件路径写入list.txt文件
Set WSH = CreateObject("wscript.shell")
mPath = ThisWorkbook.Path
WSH.Run Environ("comspec") & " /c dir """ & mPath & "\*.*"" /s/b/a-d>""" & mPath & "\list.txt""", 0, 1
回复 liulang0808 2018-11-16 22:24
和DATEDIF函数类似
Excel 中有一些隐藏函数
今天介绍一个NUMBERSTRING函数

含义
EXCEL中隐藏了一个将小写数字转换成中文大写数字的函数:NUMBERSTRING,此函数可以方便的实现小写数字到中文大写数字的转化,而且有三个参数可以选择,以展现三种不同的大写方式。此函数仅支持正整数,不支持有小数的数字。

语法
=NUMBERSTRING(VALUE,TYPE)
value:要转化的数字
type:返回结果的类型,有三种:1,2,3

示例
=NumberString(1234567890,1) 返回结果:一十二亿三千四百五十六万七千八百九十
=NumberString(1234567890,2) 返回结果:壹拾贰亿叁仟肆佰伍拾陆万柒仟捌佰玖拾
=NumberString(1234567890,3) 返回结果:一二三四五六七八九0
回复 liulang0808 2018-12-22 16:18
brr = [a1].CurrentRegion
Rng = Application.WorksheetFunction.Index(brr, 0, 1)     '取第1列
[g1].Resize(UBound(Rng)) = Rng
回复 liulang0808 2019-10-18 18:49
Sub 按钮1_Click()
    arr = [d1].CurrentRegion
    Application.ScreenUpdating = False
    For j = 1 To UBound(arr)
        str1 = ""
        For i = 1 To UBound(arr, 2)
            lenbb = LenB(StrConv(arr(j, i), vbFromUnicode)) '区分单双字节
            If i = 2 Then x = 15 Else x = 5
            str1 = str1 & arr(j, i) & Space(x - lenbb)
        Next i
        arr(j, 1) = Trim(str1)
    Next j
    [a1].Resize(UBound(arr)) = arr
    Application.ScreenUpdating = True
    Columns("A:A").Font.Name = "楷体_GB2312"
End Sub
回复 liulang0808 2019-10-18 21:47
Sub ReadFromWord()
    Dim oWordApp As Object, oDoc As Object, txt$
    Dim myPath$, MyName$, k%, Result(1 To 10000, 1 To 8)
   
    On Error Resume Next
    Range("A2:H10000").ClearContents
    myPath = ThisWorkbook.Path & "\"
    MyName = Dir(myPath & "*.doc?")
    Set oWordApp = CreateObject("Word.Application")

    Do While MyName <> ""
            Set oDoc = GetObject(myPath & MyName)
            txt = oDoc.Range.Text
            oDoc.Close True
            
            k = k + 1
            Result(k, 1) = Split(MyName, ".")(0)
            Result(k, 2) = RegxFind(txt, "姓名(\S*)\s")
            Result(k, 3) = RegxFind(txt, "身份证号(\d*)\D")
            Result(k, 4) = RegxFind(txt, "手机号码(\d+)")
            Result(k, 5) = RegxFind(txt, "性别(\S*)\s")
            Result(k, 6) = RegxFind(txt, "年龄(\S*)\s")
            Result(k, 7) = RegxFind(txt, "生日(\S*)\s")
            Result(k, 8) = RegxFind(txt, "身份证所在地(\S*)\s")
            
         MyName = Dir
    Loop
    Range("A2").Resize(k, 8) = Result
    Set oWordApp = Nothing
End Sub

Function RegxFind(strValue As String, strFind As String) As String
    Dim RegX As Object, objMatchs As Object
    Dim strTemp As String
   
    Set RegX = CreateObject("vbscript.regexp")
    RegX.Pattern = strFind
   
    Set objMatchs = RegX.Execute(strValue)
    strTemp = objMatchs(0).SubMatches(0)
   
    Set RegX = Nothing
    RegxFind = strTemp
End Function
回复 liulang0808 2019-10-19 18:36
picName = ThisWorkbook.Path & "\QQ截图20191019183529.jpg"
     Shell "rundll32.exe C:\WINDOWS\system32\shimgvw.dll,ImageView_Fullscreen " & picName, vbNormalFocus
打开图片文件
回复 liulang0808 2019-10-19 19:13
Shell "explorer D:\打样\" & [A9] & ".jpg"
回复 liulang0808 2019-10-21 12:57
ActiveSheet.HPageBreaks.Add before:=ActiveCell
使用 HPageBreaks 属性可返回 HPageBreaks 集合。使用 Add 方法可添加一个水平分页符。下例在活动单元格上方添加一个水平分页符。
回复 liulang0808 2019-11-7 12:53
Sub test()
Dim Fso As Object
Set Fso = CreateObject("scripting.filesystemobject")
Fso.createtextfile([a1]).write [b2]
End Sub
回复 liulang0808 2020-1-18 11:34
Sub test()
With Sheets(1).Shapes(Application.Caller)
  .Width = .Width * 2
  .Height = .Height * 2
End With
End Sub
图片关联代码,点击图片放大图片
回复 liulang0808 2020-2-6 15:01
For Each Rng In [a5:a10]
        MsgBox Rng.FormatConditions(1).Formula1
    Next Rng
、读取条件格式
回复 liulang0808 2020-2-6 19:02
range.DisplayFormat.Font.ColorIndex 条件格式颜色
range.FormatConditions(1).Formula1 读取条件格式的条件(公式包含“=”)
回复 liulang0808 2020-2-7 20:27
Sub tpgszf()
    Dim wip, wimg
    wBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}" 'bmp转
    wPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" 'png转
    wGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}" 'gif转
    wJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" 'jpeg转
    wTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}" 'tiff转
    Set wimg = CreateObject("WIA.ImageFile")
    Set wip = CreateObject("WIA.ImageProcess")
    wimg.LoadFile "D:\图片名称.png"
    wip.Filters.Add wip.FilterInfos("Convert").FilterID
    wip.Filters(1).Properties("FormatID").Value = wPNG
    Set wimg = wip.Apply(wimg)
    wimg.SaveFile "D:\图片名称.jpg"
End Sub
回复 liulang0808 2020-2-8 21:24
Sub 去重多个Item求和()
Dim brr, x
Dim ARR()
Dim CRR
  Set d = CreateObject("scripting.dictionary")  '创建字典
     brr = Range("b4:g1000")
       For x = 1 To UBound(brr)
         If d.existS(brr(x, 1)) Then

            CRR = d(brr(x, 1))
            For I = 1 To UBound(CRR)
                CRR(I) = CRR(I) + brr(x, I + 2)
            Next I
            d(brr(x, 1)) = CRR
         Else
            ReDim ARR(1 To 4)
            For I = 1 To 4
                ARR(I) = ARR(I) + brr(x, I + 2)
            Next I
            d(brr(x, 1)) = ARR
         End If

       Next x
        SHX.Range("B4:G1048576").ClearContents
        SHX.Cells(4, 2).Resize(d.Count) = WorksheetFunction.Transpose(d.Keys)
        SHX.Cells(4, 4).Resize(d.Count, 4) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(d.items))   '
End Sub
字典数组赋值。。。
回复 liulang0808 2020-2-17 15:17
MsgBox Application.WorksheetFunction.Text(Date, "[DBNum1]YYYY年M月D日") 显示中文日期
回复 liulang0808 2020-2-20 08:00
Sub xmlhttpread()
   Dim FileName, ar, xx, y, i, [a:zz] = ""
   Set xx = CreateObject("Microsoft.XMLHTTP")
   FileName = Dir(ThisWorkbook.Path & "\*.txt")
   Do Until Len(FileName) = 0
       y = xx.Open("Get", ThisWorkbook.Path & "\" & FileName, False)
       xx.send: y = xx.responseText
       ar = Application.Transpose(Split(y, vbCrLf))
       i = i + 1: Cells(1, i).Resize(UBound(ar)) = ar
       FileName = Dir
   Loop
End Sub 多文本文件汇总
回复 liulang0808 2020-3-8 13:22
j9568 发表于 2020-3-8 11:14
谢谢回复,请问还用写public function 和 end function等么?还是直接就可以用。在录制宏时,怎么显示“ ...

2楼、3楼代码只是一条执行语句,把它加入到过程中:
Sub Test()
    Application.DisplayFormulaBar = False
    ActiveWindow.DisplayHeadings = False
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
   
    你的过程命令1
    你的过程命令2
    你的过程命令3
    …………
   
    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub
隐藏跟显示功能区
回复 liulang0808 2020-4-7 19:29
今天介绍一个NUMBERSTRING函数

含义
EXCEL中隐藏了一个将小写数字转换成中文大写数字的函数:NUMBERSTRING,此函数可以方便的实现小写数字到中文大写数字的转化,而且有三个参数可以选择,以展现三种不同的大写方式。此函数仅支持正整数,不支持有小数的数字。

语法
=NUMBERSTRING(VALUE,TYPE)
value:要转化的数字
type:返回结果的类型,有三种:1,2,3

示例
=NumberString(1234567890,1) 返回结果:一十二亿三千四百五十六万七千八百九十
=NumberString(1234567890,2) 返回结果:壹拾贰亿叁仟肆佰伍拾陆万柒仟捌佰玖拾
=NumberString(1234567890,3) 返回结果:一二三四五六七八九0
回复 liulang0808 2020-4-12 17:36
If LCase([h1]) <> "ready" Then Exit Sub
        r = Cells(Rows.Count, 8).End(3).Row
        If r > 4 Then
            arr = Range("a4:h" & r)
            str1 = "<table border=""1""><tr>"
            For j = 1 To 6
                str1 = str1 & "<td>" & arr(1, j) & "</td>"
            Next j
            str1 = str1 & "</tr>"
            For j = 2 To UBound(arr)
                If UCase(arr(j, 8)) = "YES" Then
                    For i = 1 To 6
                        str1 = str1 & "<td>" & arr(j, i) & "</td>"
                    Next i
                    str1 = str1 & "</tr>"
                End If
            Next j
            str1 = str1 & "</table>"
            Dim olApp, Mymail
            Set olApp = CreateObject("Outlook.Application")
            Set Mymail = olApp.CreateItem(0)
            With Mymail
                .To = " @QQ.COM"
                .Subject = ("ME内部通知")
'                .Body = str1 & Chr(10) & str2
                .HTMLBody = str1
                .Save
                .send
            End With
        End If
outlook发邮件
回复 liulang0808 2020-6-12 12:38
Dim DriveID
    Dim a As String
    Set DriveID = CreateObject("Scripting.FileSystemObject")
    a = DriveID.GetDrive("C").SerialNumber
获取硬盘序列号

facelist

您需要登录后才可以评论 登录 | 免费注册

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2021-9-22 12:58 , Processed in 0.069790 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

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

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

返回顶部