kob / office Goto Github PK

Sub 宏9()

Dim xLApp
Dim xlBook
Dim xlSheet
FileDir = "d:\2.xlsx"

On Error Resume Next
Set xLApp = GetObject(, "Excel.Application") '判断Excel是否打开
If Err.Number <> 0 Then
Set xLApp = CreateObject("Excel.Application") '创建EXCEL对象
xLApp.Visible = False '设置EXCEL对象不可见
End If
Err.Clear
If Dir(FileDir) = "" Then '判断文件是否存在
MsgBox FileDir & "：未找到！", vbOKOnly, "友情提示"
Exit Sub
End If
'判断文件是否打开
For Each xlBook In xLApp.Workbooks
If xlBook.Name Then
MsgBox "文件已打开！请不要重复打开。", vbOKOnly, "友情提示"
xlBook.Activate
xLApp.WindowState = xlMaximized
Exit Sub
End If
Next
Set xlBook = xLApp.Workbooks.Open(FileDir) '打开工件簿文件
xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL启动宏
xLApp.Visible = True
Set xlSheet = xlBook.Worksheets(1)
Dim i, j, k, m As Integer
m = 0
For i = 2 To 201

j = Int(xlSheet.Cells(i, 2)) - m

k = Int(j + 1)

'Selection.TypeText Text:="P" Selection.InsertCrossReference ReferenceType:="编号项", ReferenceKind:= _
'wdPageNumber, ReferenceItem:=j, InsertAsHyperlink:=True, _
IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
' Selection.TypeText Text:=xlSheet.Cells(i, 4)
' Selection.MoveDown Unit:=wdLine, Count:=1
If j < 0 Then
Exit Sub
Else
ActiveDocument.Range(Selection.GoTo(wdGoToPage, wdgotoabsolote, j).Start, Selection.GoTo(wdGoToPage, wdGoToAbsolute, k).End).Delete
m = m + 1
End If
Next

End Sub

`Sub Macro1()
'
' Macro1 Macro
'

'
Dim i, j, k As Integer
Dim m, n As Integer
k = 0
For i = 1 To 89
If Cells(i, 2) = "" Then

Else
m = Int(Cells(i, 3) - Cells(i, 2))

For j = 1 To m + 1
k = k + 1
Cells(k, 5) = Cells(i, 2) + j - 1
Next
End If

Next
End Sub
`

Sub del_key()
Dim str As String
Dim table_count, i, j, table_lie As Integer
str = "红光笔度"
table_count = ActiveDocument.Tables.Count
For i = 1 To table_count
table_lie = ActiveDocument.Tables(i).Columns.Count
For j = 1 To table_lie
If InStr(ActiveDocument.Tables(i).Cell(1, j), str) > 0 Then
ActiveDocument.Tables(i).Cell(1, j).Select
Selection.Columns.Delete
With ActiveDocument.Tables(i)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 110
End With
ActiveDocument.Tables(i).Rows.Alignment = wdAlignRowCenter
End If
Next
Next
End