VBA Excel для Mac - невозможно изменить ActiveCell - PullRequest
Новая
       16

VBA Excel для Mac - невозможно изменить ActiveCell

0 голосов
/ 18 ноября 2018

Примечание. Я пытаюсь выполнить это на Mac.

У меня есть несколько рабочих книг с информацией о счете-фактуре, изложенной в формате счета-фактуры, и мне нужно извлечь на них различные фрагменты данных и скомпилировать таблицукоторые можно импортировать в другое программное обеспечение.

Вот код, который я написал: 

Sub GetFile()

Dim fNameAndPath As Variant
Dim wbdata As Workbook
Dim wbsource As Workbook
Dim ShToCopy As Worksheet
Dim rangedata As Range

'set data workbook
Set wbdata = ThisWorkbook
Set rangedata = ActiveCell

'open other workbook and set as source workbook

fNameAndPath = Application.GetOpenFilename
If fNameAndPath = False Then Exit Sub
Set wbsource = Workbooks.Open(fNameAndPath)
Set ShToCopy = wbsource.Worksheets("PCO #")


Call Extract_Invoice_Data_1(wbdata, wbsource, ShToCopy, rangedata)
Call Extract_Invoice_Data_2(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_3(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_4(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_5(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_6(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_7(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_8(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_9(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_10(wbdata, wbsource, ShToCopy)
Call Extract_Invoice_Data_11(wbdata, wbsource, ShToCopy)


wbsource.Close SaveChanges:=False
Set wbsource = Nothing

End Sub

Sub Extract_Invoice_Data_1(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet, rangedata As Range)

    rangedata.Value = ShToCopy.Range("G5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_2(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_3(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C3").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_4(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C4").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_5(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C5").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_6(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("C6").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_7(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G32").Value
    ActiveCell.Offset(0, 1).Activate

End Sub


Sub Extract_Invoice_Data_8(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G25").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_9(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G28").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_10(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G21").Value
    ActiveCell.Offset(0, 1).Activate

End Sub

Sub Extract_Invoice_Data_11(wbdata As Workbook, wbsource As Workbook, 
ShToCopy As Worksheet)

    Set rangedata = ActiveCell
    rangedata.Value = ShToCopy.Range("G22").Value
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=RC[-1]*0.15"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell = "=SUM(RC[-4]:RC[-1])"
    ActiveCell.Offset(0, 1).Activate

End Sub

Проблема в том, что он будет вводить данные только в первую ячейку таблицы данных изатем не извлекать какие-либо другие данные.Пожалуйста, помогите!

1 Ответ

0 голосов
/ 19 ноября 2018

Не проверено, но вы видите, как это может работать без использования ActiveCell / Activate и т. Д .: 

Sub ChooseInputFileAndExtractData()

    Dim fNameAndPath As Variant
    Dim wbsource As Workbook
    Dim destRow As Range

    Set destRow = ActiveCell.EntireRow  'get the selected Row

    'open other workbook and set as source workbook
    fNameAndPath = Application.GetOpenFilename
    If fNameAndPath <> False Then
        Set wbsource = Workbooks.Open(fNameAndPath)

        ExtractInvoiceData destRow, wbsource.Worksheets("PCO #")

        wbsource.Close SaveChanges:=False
        Set wbsource = Nothing
    End If

End Sub

Sub ExtractInvoiceData(destRow As Range, SourceSheet As Worksheet)
    With destRow
        .Cells(1).Value = SourceSheet.Range("G5").Value
        .Cells(2).Value = SourceSheet.Range("G4").Value
        .Cells(3).Value = SourceSheet.Range("C3").Value
        .Cells(4).Value = SourceSheet.Range("C4").Value
        .Cells(5).Value = SourceSheet.Range("C5").Value
        .Cells(6).Value = SourceSheet.Range("C6").Value
        .Cells(7).Value = SourceSheet.Range("G32").Value
        .Cells(8).Value = SourceSheet.Range("G25").Value
        .Cells(9).Value = SourceSheet.Range("G28").Value
        .Cells(10).FormulaR1C1 = "=RC[-1]*0.15" '
        'etc etc you get the idea
    End With
End Sub
...