PDA

Показать полную графическую версию : макрос excel


Страниц : 1 [2]

Iska
20-07-2015, 17:48
Там лишнее.
.Replace "02.07.2015", "09.07.2015"

Maza11
20-07-2015, 17:59
это я пытался на основе вашего скрипта модифицировать
сделал так
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

Iska
20-07-2015, 18:44
ругается, требуется объект objFile »
Значит, Вы что-то не то передаёте в процедуру.

Maza11
20-07-2015, 20:32
Значит, Вы что-то не то передаёте в процедуру. »
за основу взят Ваш скрипт


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
'=============================================================================

Iska
21-07-2015, 00:20
Это не мой скрипт. Это непонятная компиляция.

Посмотрите сами:

WorkingWithWorkbook objFile, .GetExtensionName(objFile.Name)

Sub WorkingWithWorkbook(objExcel, objFile)

Maza11
21-07-2015, 09:23
вот скрипт

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
не понимаю почему так. для одних файлов работает. для других нет

Maza11
21-07-2015, 09:57
похоже это ошибка уже не в скрипте т.к. те скрипты из которых брался код тоже стали эту ошибку выдавать на моменте сохранения, хотя они 100% рабочие, бред какой то уже

Maza11
21-07-2015, 10:12
бред заключается в том, что с логотипами и процентами теми которые вы убирали изначально в скрипте, он не сохраняет измененную дату, если прогнать сначала скриптом убирающим их, а потом меняющим дату, то все ок

именно по этой причине в одних накладных работало, а в других нет.




© OSzone.net 2001-2012