Macros

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

Sub simpleTestExcelDataRetrieve()
 'The code needs a reference to 'Microsoft Excel xx.x Object Library' where xx.x is the Ofice/Excel version
 'installed on your computer. For instance, in my case I use 16.00 (Office 2016...)
 
 Dim Exl As Excel.Application, w As Workbook, Wg As Workbook, Pg As Worksheet, R As Range
 Dim Mf As Variant, lastColumn As Long, lastRow As Long, nLastCol As String, i As Long
 Dim boolFound As Boolean
 
    Set Exl = GetObject(, "Excel.Application")
    Exl.Visible = True
    
    For Each w In Exl.Workbooks
        'If w.name = "test.xlsx" Then Set Wg = w: boolFound = True: Exit For
        If w.name = "Oreo 24x12.xls" Then Set Wg = w: boolFound = True: Exit For
        'Oreo 24x12.xls
    Next
    If Not boolFound Then MsgBox "There is not any ""test.xlsx"" open in Excel." & vbCrLf & _
                    "Please open it and try again", vbInformation, "Missing open Excel file": Exit Sub
                    
    Set Pg = Wg.Sheets(1):  Set R = Pg.UsedRange
    lastColumn = R.Columns.Count: lastRow = R.Rows.Count
    nLastCol = Split(R.Cells(, lastColumn).Address, "$")(1)
    
    Mf = Pg.Range("A1:" & nLastCol & lastRow).Value
    'Now all your Excel file data are inside of the Mf array...
    '________________________end Excel data collection___________
    
    'Corel part:__________________________________________________________
    Dim shR As ShapeRange, sh As Shape
    Set shR = ActivePage.Shapes.FindShapes(, cdrTextShape)
    For Each sh In shR.Shapes
        For i = 1 To lastColumn
            If sh.name Like Mf(1, i) Then
                sh.Text.Story = Mf(2, i): Exit For
            End If
        Next i
    Next
    '________________________end Corel data pasting________________________
End Sub