Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Название темы: макрос excel
Показать сообщение отдельно

Аватара для Maza11

Старожил


Сообщения: 284
Благодарности: 2

Профиль | Отправить PM | Цитировать


вот скрипт
скрипт оригинал
Код: Выделить весь код
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/9...a20229c1c14670

но для двух других файлов, где это ячейка "A3:G3" не работает (просто меняю адрес ячейки)
http://rghost.ru/private/8V2CByf99/7...0a7ebd236852ec
выдает ошибка 800A03EC, адрес строка 71 символ 4 это символ табуляции перед Save
не понимаю почему так. для одних файлов работает. для других нет

Последний раз редактировалось Maza11, 21-07-2015 в 09:47.


Отправлено: 09:23, 21-07-2015 | #26

Название темы: макрос excel