Excel Circle открывает книги и изменяет каждый лист - PullRequest
Новая
       33

Excel Circle открывает книги и изменяет каждый лист

0 голосов
/ 12 февраля 2019

У меня есть 10 текстовых файлов в каталоге.Я хочу внести в них некоторые изменения в Excel.Мне нужно открыть все для разных рабочих книг, просмотреть каждую рабочую книгу и внести некоторые изменения. Или, может быть, будет даже лучше открыть все в одном файле, на разных рабочих листах.

Это мой необработанный макрос (это не работает), я, возможно, добавлю больше материала к нему, но основная идея состоит в том, чтобы просмотреть все рабочие книги (если это будет рабочий лист, я думаю, что я знаю, как это сделать, и мне просто нужнопомогите переместить текстовые файлы в рабочие листы)

любая помощь будет высоко ценится! 

Sub ExifToolEdit()

Dim wb As Workbook


For Each wb In Application.Workbooks
  If wb.Name <> "PERSONAL.xlsb" Then

    wb.Activate
    If Worksheets(1).Name <> "Default" Then
    Worksheets(1).Name = "Default"
    End If

wb.Worksheets.Add After:=wb.Worksheets(1)
wb.Worksheets(2).Name = "Edited"



Dim LastRow As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row


Columns("B").NumberFormat = "@"



Dim EndOfColumnA As Integer
For i = 1 To LastRow




    Cells(i, 2) = Right(Cells(i, 1), Len(Cells(i, 1)) - InStr(Cells(i, 1), ":") - 1)

    Cells(i, 1) = Left(Cells(i, 1), EndOfColumnA - 1)

End If

Next i

Columns(1).Select
ActiveCell.EntireColumn.Columns.AutoFit

Columns(2).Select
ActiveCell.EntireColumn.Columns.AutoFit

Cells(1, 3) = Cells(4, 2) & "/" & Cells(3, 2)



    Dim Pshp As shape
    Dim xRg As Range
    Dim xCol As Long
    Dim WidthFlag As Boolean
    Dim myRow, myColumn, LastRowFromCurrent As Integer

    Cells(1, 3).Select

    On Error Resume Next
    Application.ScreenUpdating = False
    Set rng = ActiveCell
    For Each cell In rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        If Pshp Is Nothing Then GoTo lab
        xCol = cell.Column + 1
        Set xRg = Cells(cell.Row, xCol)

        With Pshp

            .LockAspectRatio = msoTrue
            .height = 250

        End With
lab:
    Next
    Application.ScreenUpdating = False


  Application.ScreenUpdating = True

  Cells(1, 3).ClearContents

End If
Next wb

End Sub
...