Показать полную графическую версию : макрос excel
Там лишнее.
.Replace "02.07.2015", "09.07.2015"
это я пытался на основе вашего скрипта модифицировать
сделал так
Sub WorkingWithWorkbook(objExcel, objFile)
WScript.Echo objFile.Path
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets.Item(1).Range("A4:I4")
.Replace "02.07.2015", "09.07.2015"
End With
.Save
.Close
End With
End With
End Sub
ругается, требуется объект objFile
ругается, требуется объект objFile »
Значит, Вы что-то не то передаёте в процедуру.
Значит, Вы что-то не то передаёте в процедуру. »
за основу взят Ваш скрипт
Option Explicit
Dim objExcel
Dim strSourceFileSystemObject
Dim objFile
If WScript.Arguments.Count > 0 Then
With WScript.CreateObject("Scripting.FileSystemObject")
Set objExcel = Nothing
For Each strSourceFileSystemObject In WScript.Arguments
If .FolderExists(strSourceFileSystemObject) Then
For Each objFile In .GetFolder(strSourceFileSystemObject).Files
WorkingWithWorkbook objFile, .GetExtensionName(objFile.Name)
Next
ElseIf .FileExists(strSourceFileSystemObject) Then
WorkingWithWorkbook .GetFile(strSourceFileSystemObject), .GetExtensionName(strSourceFileSystemObject)
Else
WScript.Echo "Can't find source file or source folder [" & strSourceFileSystemObject & "]."
End If
Next
If Not objExcel Is Nothing Then
objExcel.Quit
Set objExcel = Nothing
End If
End With
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file or source folder> [<Source file or source folder> [...]]"
WScript.Quit 1
End If
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub WorkingWithWorkbook(objExcel, objFile)
WScript.Echo objFile.Path
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets(1).Range("A4:I4")
.Replace "02.07.2015", "09.07.2015"
End With
.Save
.Close
End With
End With
End Sub
'=============================================================================
Это не мой скрипт. Это непонятная компиляция.
Посмотрите сами:
…
WorkingWithWorkbook objFile, .GetExtensionName(objFile.Name)
…
Sub WorkingWithWorkbook(objExcel, objFile)
…
вот скрипт
Option Explicit
Dim strSourceFileSystemObject
Dim objFile
Dim objExcel
If WScript.Arguments.Count = 1 Then
strSourceFileSystemObject = WScript.Arguments.Item(0)
With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFileSystemObject) Then
Set objExcel = Nothing
For Each objFile In .GetFolder(strSourceFileSystemObject).Files
Select Case LCase(.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
WorkingWithWorkbook objExcel, objFile
Case Else
' Nothing to do
End Select
Next
If Not objExcel Is Nothing Then
objExcel.Quit
Set objExcel = Nothing
End If
ElseIf .FileExists(strSourceFileSystemObject) Then
Set objFile = .GetFile(strSourceFileSystemObject)
Select Case LCase(.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
With WScript.CreateObject("Excel.Application")
WorkingWithWorkbook .Application, objFile
.Quit
End With
Case Else
WScript.Echo "Source file [" & strSourceFileSystemObject & "] probably has not an Excel Workbook."
End Select
Set objFile = Nothing
Else
WScript.Echo "Can't find source file or source folder [" & strSourceFileSystemObject & "]."
WScript.Quit 2
End If
End with
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file or source folder>"
WScript.Quit 1
End If
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub WorkingWithWorkbook(objExcel, objFile)
WScript.Echo objFile.Path
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets.Item(1)
.Shapes.Item("Picture -767").Delete
.Range("H4:I6").Select
objExcel.Selection.ClearContents
.Range("A1").Select
objExcel.Union(.Rows(.UsedRange.Rows.Count).EntireRow, .Rows(.UsedRange.Rows.Count -1).EntireRow).Delete
With .PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
.PrintOut ,, 3
End With
.Save
.Close
End With
End With
End Sub
в нем я просто меняю эту часть
With .Workbooks.Open(objFile.Path)
With .Worksheets.Item(1)
.Shapes.Item("Picture -767").Delete
.Range("H4:I6").Select
objExcel.Selection.ClearContents
.Range("A1").Select
objExcel.Union(.Rows(.UsedRange.Rows.Count).EntireRow, .Rows(.UsedRange.Rows.Count -1).EntireRow).Delete
With .PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
.PrintOut ,, 3
End With
.Save
.Close
End Withна эту
With .Workbooks.Open(objFile.Path)
With .Worksheets(1).Range("A4:I4")
.Replace "02.07.2015", "09.07.2015"
End With
.Save
.Close
End With
получается
Option Explicit
Dim strSourceFileSystemObject
Dim objFile
Dim objExcel
If WScript.Arguments.Count = 1 Then
strSourceFileSystemObject = WScript.Arguments.Item(0)
With WScript.CreateObject("Scripting.FileSystemObject")
If .FolderExists(strSourceFileSystemObject) Then
Set objExcel = Nothing
For Each objFile In .GetFolder(strSourceFileSystemObject).Files
Select Case LCase(.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
If objExcel Is Nothing Then
Set objExcel = WScript.CreateObject("Excel.Application")
End If
WorkingWithWorkbook objExcel, objFile
Case Else
' Nothing to do
End Select
Next
If Not objExcel Is Nothing Then
objExcel.Quit
Set objExcel = Nothing
End If
ElseIf .FileExists(strSourceFileSystemObject) Then
Set objFile = .GetFile(strSourceFileSystemObject)
Select Case LCase(.GetExtensionName(objFile.Name))
Case "xls", "xlsx"
With WScript.CreateObject("Excel.Application")
WorkingWithWorkbook .Application, objFile
.Quit
End With
Case Else
WScript.Echo "Source file [" & strSourceFileSystemObject & "] probably has not an Excel Workbook."
End Select
Set objFile = Nothing
Else
WScript.Echo "Can't find source file or source folder [" & strSourceFileSystemObject & "]."
WScript.Quit 2
End If
End with
Else
WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source file or source folder>"
WScript.Quit 1
End If
WScript.Quit 0
'=============================================================================
'=============================================================================
Sub WorkingWithWorkbook(objExcel, objFile)
WScript.Echo objFile.Path
With objExcel
With .Workbooks.Open(objFile.Path)
With .Worksheets(1).Range("A4:I4")
.Replace "02.07.2015", "15.07.2015"
End With
.Save
.Close
End With
End With
End Sub
и для этих файлов он работает
http://rghost.ru/private/7pFNmtcC7/95f22ecfadca076251a20229c1c14670
но для двух других файлов, где это ячейка "A3:G3" не работает (просто меняю адрес ячейки)
http://rghost.ru/private/8V2CByf99/7c4d60f61c1b3c727d0a7ebd236852ec
выдает ошибка 800A03EC, адрес строка 71 символ 4 это символ табуляции перед Save
не понимаю почему так. для одних файлов работает. для других нет
похоже это ошибка уже не в скрипте т.к. те скрипты из которых брался код тоже стали эту ошибку выдавать на моменте сохранения, хотя они 100% рабочие, бред какой то уже
бред заключается в том, что с логотипами и процентами теми которые вы убирали изначально в скрипте, он не сохраняет измененную дату, если прогнать сначала скриптом убирающим их, а потом меняющим дату, то все ок
именно по этой причине в одних накладных работало, а в других нет.
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.
Available in ZeroNet 1osznRoVratMCN3bFoFpR2pSV5c9z6sTC