VBA - макрос excel

[Maza11]

нужно в документе менять дату

делаю так



Код:

Код: Выделить всё

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", Replacement:="09.07.2015"							
			End With
			.Save
			.Close
		End With
	End With
End Sub

ругается 800A0400 по адресу перед .Replace, какого там оператора не хватает ???



Подскажите пожалуйста

[Maza11]

это я пытался на основе вашего скрипта модифицировать

сделал так



Код:

Код: Выделить всё

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]

Цитата Maza11:



ругается, требуется объект objFile

VBA - макрос excel

Значит, Вы что-то не то передаёте в процедуру.

[Maza11]

Цитата Iska:



Значит, Вы что-то не то передаёте в процедуру.

VBA - макрос excel

за основу взят Ваш скрипт



скрипт

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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 & """  [ [...]]"
	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]

Это не мой скрипт. Это непонятная компиляция.



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



Код:

Код: Выделить всё

…
WorkingWithWorkbook objFile, .GetExtensionName(objFile.Name)
…
Sub WorkingWithWorkbook(objExcel, objFile)
…

[Maza11]

вот скрипт



скрипт оригинал

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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 & """ "
    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

получается



скрипт измененный

[spoiler]Код:

[/spoiler]

Код: Выделить всё

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 & """ "
    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/9...a20229c1c14670

но для двух других файлов, где это ячейка "A3:G3" не работает (просто меняю адрес ячейки)

http://rghost.ru/private/8V2CByf99/7...0a7ebd236852ec

выдает ошибка 800A03EC, адрес строка 71 символ 4 это символ табуляции перед Save

не понимаю почему так. для одних файлов работает. для других нет

[Maza11]

похоже это ошибка уже не в скрипте т.к. те скрипты из которых брался код тоже стали эту ошибку выдавать на моменте сохранения, хотя они 100% рабочие, бред какой то уже

[Maza11]

бред заключается в том, что с логотипами и процентами теми которые вы убирали изначально в скрипте, он не сохраняет измененную дату, если прогнать сначала скриптом убирающим их, а потом меняющим дату, то все ок



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