在sheet的源码中:
Private Sub CommandButton2_Click()
If Range("C8") = "" Or Range("D8") = "" Then
MsgBox "PLEASE INPUT CLASS!"
Range("C8").Select
Exit Sub
End If
For i = 17 To 20000If Range("A" & i) = "" Then
Exit For
End If
Range("A" & i & ":E" & i) = ""
Next If OptionExcel.Value = True Then
printexcel
ElseIf OptionWord.Value = True Then
printWORD
ElseIf OptionTxt.Value = True Then
printTxt filepatht.Text, "*.txt", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionHtml.Value = True Then
printTxt filepatht.Text, "*.html", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionJs.Value = True Then
printTxt filepatht.Text, "*.js", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionCss.Value = True Then
printTxt filepatht.Text, "*.css", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionXml.Value = True Then
printTxt filepatht.Text, "*.xml", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionJsp.Value = True Then
printTxt filepatht.Text, "*.jsp", "/*** Classification: *-----------------------------------------------------------*/"
ElseIf OptionJava.Value = True Then
printTxt filepatht.Text, "*.java", "/*** Classification: *-----------------------------------------------------------*/" End If
End Sub模板中:
Sub printexcel()
On Error Resume Next
Dim appiai As Application
Dim iraisheet As Workbook
Dim wksheet As Worksheet
Dim mysheet As Worksheet
Dim FilePath As String
Dim i As Integer Dim fsiai As FileSearch
Dim strclass As String
Dim line As Integer
line = 17
strclass = Range("c8") & " " & Range("d8")
Set mysheet = Sheets("GESETUP")
Set appiai = Application
Set fsiai = appiai.FileSearch
FilePath = ThisWorkbook.ActiveSheet.filepatht.Text
getFile fsiai, FilePath
ThisWorkbook.ActiveSheet.Starttime.Caption = Time
ThisWorkbook.ActiveSheet.count.Caption = fsiai.FoundFiles.count
For i = 1 To fsiai.FoundFiles.count
mysheet.Range("a" & line) = strclass
mysheet.Range("c" & line) = fsiai.FoundFiles.Item(i)
line = line + 1
ThisWorkbook.ActiveSheet.filenum.Caption = i
Set iraisheet = Excel.Application.Workbooks.Open(fsiai.FoundFiles.Item(i))
ThisWorkbook.Activate
DoEvents
For Each wksheet In iraisheet.Sheets
DoEvents
With wksheet.PageSetup
.CenterFooter = "&""Trebuchet MS,MS UI Gothic""&10 Classification: " & strclass
End With
Next
iraisheet.Save
iraisheet.Close True Next
ThisWorkbook.ActiveSheet.finishtime.Caption = Time
MsgBox "GE_SETUP ok!"
End SubSub printWORD()
On Error Resume Next
Dim appiai As Application
Dim wd As Object
Dim fsiai As FileSearch
Dim FilePath As String
Dim i As Integer
Dim wordApp As Object
Dim j As Integer
Dim aa As Word.Application
Dim wdiai As FileSearch
Dim mysheet As Worksheet
Dim strclass As String
Dim line As Integer
line = 17
Set mysheet = Sheets("GESETUP")
strclass = Range("c8") & " " & Range("d8")
Set wordApp = CreateObject("word.application")
Set appiai = Application
Set fsiai = appiai.FileSearch
FilePath = ThisWorkbook.ActiveSheet.filepatht.Text
getwdFile fsiai, FilePath
ThisWorkbook.ActiveSheet.Starttime.Caption = Time
ThisWorkbook.ActiveSheet.count.Caption = fsiai.FoundFiles.count
ThisWorkbook.Activate
Dim txt As String
For i = 1 To fsiai.FoundFiles.count
mysheet.Range("a" & line) = strclass
mysheet.Range("c" & line) = fsiai.FoundFiles.Item(i)
line = line + 1
txt = ""
ThisWorkbook.ActiveSheet.filenum.Caption = i
Set wd = wordApp.Documents.Open(fsiai.FoundFiles.Item(i))
DoEvents
txt = wd.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text
wd.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Classification: " & strclass
DoEvents
wd.Save
wd.Close
Next
ThisWorkbook.ActiveSheet.finishtime.Caption = Time
wordApp.Close
wordApp.Quit MsgBox "GE_SETUP ok!"
End Sub
Sub printTxt(ByVal myPath As String, ByVal filePattern As String, ByVal replaceValue As String)
On Error Resume Next
Dim nFileNum As Integer, sFileName As String
Dim aBytes() As Byte, aLines() As String
Dim line As Integer
Dim strclass As String
line = 17
strclass = Range("c8") & " " & Range("d8")
sFileName = Dir(myPath & "\" & filePattern)
While LenB(sFileName)
nFileNum = FreeFile()
Open myPath & "\" & sFileName For Binary Access Read As #nFileNum
ReDim aBytes(LOF(nFileNum) - 1)
Get #nFileNum, , aBytes
Close #nFileNum
aLines = Split(StrConv(aBytes, vbUnicode), vbCrLf)
aLines(0) = replaceValue
aBytes = StrConv(Join(aLines, vbCrLf), vbFromUnicode)
nFileNum = FreeFile()
Kill myPath & "\" & sFileName
Open myPath & "\" & sFileName For Binary Access Write As #nFileNum
Put #nFileNum, , aBytes
Close #nFileNum
sFileName = Dir() Wend
Dim lsheet As Worksheet
Set lsheet = Sheets("GESETUP")
filePattern = Dir(myPath & "\" & filePattern, vbDirectory)
While filePattern <> ""
lsheet.Range("$a$" & line) = strclass
lsheet.Range("$c$" & line).Value = myPath & "\" & filePattern
line = line + 1
filePattern = Dir() Wend MsgBox "ok!"
End Sub
原来只是把首行替代,现在要实现插入多行。。
Private Sub CommandButton2_Click()
If Range("C8") = "" Or Range("D8") = "" Then
MsgBox "PLEASE INPUT CLASS!"
Range("C8").Select
Exit Sub
End If
For i = 17 To 20000If Range("A" & i) = "" Then
Exit For
End If
Range("A" & i & ":E" & i) = ""
Next If OptionExcel.Value = True Then
printexcel
ElseIf OptionWord.Value = True Then
printWORD
ElseIf OptionTxt.Value = True Then
printTxt filepatht.Text, "*.txt", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionHtml.Value = True Then
printTxt filepatht.Text, "*.html", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionJs.Value = True Then
printTxt filepatht.Text, "*.js", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionCss.Value = True Then
printTxt filepatht.Text, "*.css", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionXml.Value = True Then
printTxt filepatht.Text, "*.xml", "<!--/*** Classification: *-----------------------------------------------------------*/-->"
ElseIf OptionJsp.Value = True Then
printTxt filepatht.Text, "*.jsp", "/*** Classification: *-----------------------------------------------------------*/"
ElseIf OptionJava.Value = True Then
printTxt filepatht.Text, "*.java", "/*** Classification: *-----------------------------------------------------------*/" End If
End Sub模板中:
Sub printexcel()
On Error Resume Next
Dim appiai As Application
Dim iraisheet As Workbook
Dim wksheet As Worksheet
Dim mysheet As Worksheet
Dim FilePath As String
Dim i As Integer Dim fsiai As FileSearch
Dim strclass As String
Dim line As Integer
line = 17
strclass = Range("c8") & " " & Range("d8")
Set mysheet = Sheets("GESETUP")
Set appiai = Application
Set fsiai = appiai.FileSearch
FilePath = ThisWorkbook.ActiveSheet.filepatht.Text
getFile fsiai, FilePath
ThisWorkbook.ActiveSheet.Starttime.Caption = Time
ThisWorkbook.ActiveSheet.count.Caption = fsiai.FoundFiles.count
For i = 1 To fsiai.FoundFiles.count
mysheet.Range("a" & line) = strclass
mysheet.Range("c" & line) = fsiai.FoundFiles.Item(i)
line = line + 1
ThisWorkbook.ActiveSheet.filenum.Caption = i
Set iraisheet = Excel.Application.Workbooks.Open(fsiai.FoundFiles.Item(i))
ThisWorkbook.Activate
DoEvents
For Each wksheet In iraisheet.Sheets
DoEvents
With wksheet.PageSetup
.CenterFooter = "&""Trebuchet MS,MS UI Gothic""&10 Classification: " & strclass
End With
Next
iraisheet.Save
iraisheet.Close True Next
ThisWorkbook.ActiveSheet.finishtime.Caption = Time
MsgBox "GE_SETUP ok!"
End SubSub printWORD()
On Error Resume Next
Dim appiai As Application
Dim wd As Object
Dim fsiai As FileSearch
Dim FilePath As String
Dim i As Integer
Dim wordApp As Object
Dim j As Integer
Dim aa As Word.Application
Dim wdiai As FileSearch
Dim mysheet As Worksheet
Dim strclass As String
Dim line As Integer
line = 17
Set mysheet = Sheets("GESETUP")
strclass = Range("c8") & " " & Range("d8")
Set wordApp = CreateObject("word.application")
Set appiai = Application
Set fsiai = appiai.FileSearch
FilePath = ThisWorkbook.ActiveSheet.filepatht.Text
getwdFile fsiai, FilePath
ThisWorkbook.ActiveSheet.Starttime.Caption = Time
ThisWorkbook.ActiveSheet.count.Caption = fsiai.FoundFiles.count
ThisWorkbook.Activate
Dim txt As String
For i = 1 To fsiai.FoundFiles.count
mysheet.Range("a" & line) = strclass
mysheet.Range("c" & line) = fsiai.FoundFiles.Item(i)
line = line + 1
txt = ""
ThisWorkbook.ActiveSheet.filenum.Caption = i
Set wd = wordApp.Documents.Open(fsiai.FoundFiles.Item(i))
DoEvents
txt = wd.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text
wd.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Classification: " & strclass
DoEvents
wd.Save
wd.Close
Next
ThisWorkbook.ActiveSheet.finishtime.Caption = Time
wordApp.Close
wordApp.Quit MsgBox "GE_SETUP ok!"
End Sub
Sub printTxt(ByVal myPath As String, ByVal filePattern As String, ByVal replaceValue As String)
On Error Resume Next
Dim nFileNum As Integer, sFileName As String
Dim aBytes() As Byte, aLines() As String
Dim line As Integer
Dim strclass As String
line = 17
strclass = Range("c8") & " " & Range("d8")
sFileName = Dir(myPath & "\" & filePattern)
While LenB(sFileName)
nFileNum = FreeFile()
Open myPath & "\" & sFileName For Binary Access Read As #nFileNum
ReDim aBytes(LOF(nFileNum) - 1)
Get #nFileNum, , aBytes
Close #nFileNum
aLines = Split(StrConv(aBytes, vbUnicode), vbCrLf)
aLines(0) = replaceValue
aBytes = StrConv(Join(aLines, vbCrLf), vbFromUnicode)
nFileNum = FreeFile()
Kill myPath & "\" & sFileName
Open myPath & "\" & sFileName For Binary Access Write As #nFileNum
Put #nFileNum, , aBytes
Close #nFileNum
sFileName = Dir() Wend
Dim lsheet As Worksheet
Set lsheet = Sheets("GESETUP")
filePattern = Dir(myPath & "\" & filePattern, vbDirectory)
While filePattern <> ""
lsheet.Range("$a$" & line) = strclass
lsheet.Range("$c$" & line).Value = myPath & "\" & filePattern
line = line + 1
filePattern = Dir() Wend MsgBox "ok!"
End Sub
原来只是把首行替代,现在要实现插入多行。。
以前只是替换首行的值
你新建一行单元格,然后按单元写入数据
在world中没试过,不过我想应该和我们操作word的方式差不多吧
在js,java中插入应该和在text中插入是一样的吧,应该和你写的那些差不多。