<dialogBoxLauncher>
    <button idMso="PageSetupDialog"/>
</dialogBoxLauncher>

<box id="__BoxPage1" boxStyle="horizontal">
    <control idMso="PageSizeGallery" showLabel="false"/>
</box>

<button 
   id="Уникальный_Идентификатор_кнопки" 
   onAction="Сюда_вставляется_имя_VBA_макроса" 
   label="Имя кнопки" 
   imageMso="Встроенная_Картинка_MSOffice" 
   screentip="Заголовок подсказки" 
   supertip="Комментарий подсказки"/>

sub 合并当前目录下所有工作簿的全部工作表() 
dim mypath, myname, awbname 
dim wb as workbook, wbn as string 
dim g as long 
dim num as long 
dim box as string 
application.screenupdating = false 
mypath = activeworkbook.path 
myname = dir(mypath & "\" & "*.xls") 
awbname = activeworkbook.name 
num = 0 
do while myname <> "" 
if myname <> awbname then 
set wb = workbooks.open(mypath & "\" & myname) 
num = num + 1 
with workbooks(1).activesheet 
.cells(.range("a65536").end(xlup).row + 2, 1) = left(myname, len(myname) - 4) 
for g = 1 to sheets.count 
wb.sheets(g).usedrange.copy .cells(.range("a65536").end(xlup).row + 1, 1) 
next 
wbn = wbn & chr(13) & wb.name 
wb.close false 
end with 
end if 
myname = dir 
loop 
range("a1").select 
application.screenupdating = true 
msgbox "共合并了" & num & "个工作薄下的全部工作表。如下：" & chr(13) & wbn, vbinformation, "提示" 
end sub

//来自：https://blog.csdn.net/weixin_43144634/article/details/82689732 

Dim objIE As SHDocVw.InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("http://contoso.com")
objIE.Visible = True

Sub format_pageviews_csv()

With ActiveWorkbook.ActiveSheet.Range("A1:B1, J1, L1:M1, P1:Q1, S1").EntireColumn
    .Delete
End With

ActiveWorkbook.ActiveSheet.Range("B1:K1").EntireColumn.AutoFit
ActiveWorkbook.ActiveSheet.Range("A1").EntireColumn.ColumnWidth = 140

With ActiveWorkbook.ActiveSheet.Range("A1:k1")
    .Font.Bold = True
    .AutoFilter
End With

End Sub

Sub findsciHub()
With Selection.Find
.ClearFormatting
    .text = "sci-hub.tw"
    .MatchWildcards = False
    Do
    .Execute
    If .Found Then
        Selection.Range.comments.add Selection.Range, "sci-hub.tw is forbidden in paper, please change."
    Else
        Exit Do
    End If
    Loop
End With

End Sub

' Test
Sub HelloWorld()
    WScript.Echo "Hello World"
End Sub

' This procedure creates XML document
' and saves it to disk.
' Requires msxml.dll (Go to Project --> References and
' and choose Microsoft XML version 2.0, or whatever the
' current version you have installed)
' The example given below will write the following XML
' documents.
'
' <Family>
'    <Member Relationship="Father">
'       <Name>Some Guy</name>
'    </member>
' </family>
'
'but it should be clear how to modify the code
'to create your own documents

Private Sub Create_XML()
   
   Dim objDom As DOMDocument
   Dim objRootElem As IXMLDOMElement
   Dim objMemberElem As IXMLDOMElement
   Dim objMemberRel As IXMLDOMAttribute
   Dim objMemberName As IXMLDOMElement
   
   Set objDom = New DOMDocument
   
   ' Creates root element
   Set objRootElem = objDom.createElement("Family")
   objDom.appendChild objRootElem
   
   ' Creates Member element
   Set objMemberElem = objDom.createElement("Member")
   objRootElem.appendChild objMemberElem
   
   ' Creates Attribute to the Member Element
   Set objMemberRel = objDom.createAttribute("Relationship")
   objMemberRel.nodeValue = "Father"
   objMemberElem.setAttributeNode objMemberRel
   
   ' Create element under Member element, and
   ' gives value "some guy"
   Set objMemberName = objDom.createElement("Name")
   objMemberElem.appendChild objMemberName
   objMemberName.Text = "Some Guy"

   ' Saves XML data to disk.
   objDom.save ("c:\temp\andrew.xml")
End Sub

Sub detectDoubleRef()
    Dim ref As New myrange
    Dim p As paragraph
    ref.refPart.Select
    For Each p In Selection.Paragraphs
        If isDoubleRef(p.Range.text) Then
            p.Range.HighlightColorIndex = 6
            p.Range.comments.Add p.Range, "There are two refs in this paragraph"
        End If
    Next
    ref.refPart.Select
    Selection.Collapse wdCollapseStart
End Sub
Function isDoubleRef(str) As Boolean
Dim reg As New RegExp
With reg
    .Pattern = "[A-Z][a-z]+?\, ([A-Z]\.)+?.+?[0-9]+?.+?[A-Z][a-z]+?\, [A-Z]\."
    .Global = True
    If .test(str) = True Then
        isDoubleRef = True
    Else
        isDoubleRef = False
    End If
End With
End Function