在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
原来只是把首行替代,现在要实现插入多行。。
解决方案 »
- 请大家进来帮忙,看一看这个错误“无效的属性值”怎么样解决
- vb 关于热键设置隐藏呼出窗体的功能
- VB在WIN2000以上操作系统上RAS拨号出现87号错误
- 一台PC里怎样知道另一个应用程序是否死掉?用什么函数把小数转成浮点数(PLC格式)?
- 急死了!那位大侠能帮忙用代码“点击”一下这个按钮?
- 请问我在使用set xlapp=new excel.application实现excel报表,但问题是当使用rang("k6")=rs!je,系统出错.
- 关于用modem录音的问题
- 救命,没有分了,可是我还是想问一下,怎样设置键盘的响应时间.谢谢
- ADODC问题:如何重新选定ADODC的数据源?
- 怎样在VB程序中打开一个EXCEL的表格?
- 请教各位老师关于select取数的问题
- vb任何锁定注册表某一分支,然后其下所有键值不能被修改
以前只是替换首行的值
你新建一行单元格,然后按单元写入数据
在world中没试过,不过我想应该和我们操作word的方式差不多吧
在js,java中插入应该和在text中插入是一样的吧,应该和你写的那些差不多。