VBA vanuit Excel in Openoffice Calc uitvoeren

[lapzwans]

Hey Allemaal,

Eerder heeft een van jullie zeer bekwame leden me geholpen aan mijn macro om plaatjes in een stramien te gieten, zoals in dit topic

http://www.helpmij.nl/forum/showthread.php/[URL="http://www.helpmij.nl/forum/showthread.php/864761-productsheet-maken-plaatjes-importeren-met-Macro"]http://www.helpmij.nl/forum/showthread.php/864761-productsheet-maken-plaatjes-importeren-met-Macro[/URL]864761-productsheet-maken-plaatjes-importeren-met-Macro

Nou werk ik in een extern bureaublad in Excel , en mijn totale picturesdatabase staat op de locale schijf. Als ik een bulk met plaatjes kopieer naar mijn Terminal dan duurt dit ellendig lang. Mijn vraag is dan ook of de volgende macro in Openoffice Calc gebruikt kan worden?

Sub Insert_Pict1()
    Dim lRow As Long, lLoop As Long
    Dim myarray As Variant, ImagePath As String
    myarray = WorksheetFunction.Transpose(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value)
    ActiveSheet.Protect False, False, False, False, False
    If Not IsArray(myarray) Then
        MsgBox "Geen bestanden geselecteerd."
        Exit Sub
    End If
    On Error Resume Next
    lRow = 2
    For lLoop = LBound(myarray) To UBound(myarray)
        ImagePath = "C:\Users\jeroen\Desktop\subfolder\" & myarray(lLoop) & ".jpg"
        If Dir(ImagePath) = vbNullString Then Cells(lRow, 7) = 0: GoTo vervolg
        Set oBmp = LoadPicture(ImagePath): x = oBmp.Height: y = oBmp.Width
        With ActiveSheet.Shapes.AddPicture(ImagePath, msoFalse, msoCTrue, Cells(1, 7).Left + 9, Cells(lRow, 7).Top + 8, 0, 0)
            If x > y Then
                'Portrait
                .Left = Cells(1, 7).Left + 9
                .Top = Cells(lRow, 7).Top + 8
                .Height = 100
                .Width = 60

            Else
                'Landscape
                .Left = Cells(1, 7).Left + 9
                .Top = Cells(lRow, 7).Top + 8
                .Height = 60
                .Width = 80
            End If
        End With
vervolg:
        lRow = lRow + 1
    Next lLoop
End Sub

Sub Del_All_Img()

    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next

End Sub

Dit zou een hoop tijd schelen

Thanks a lot

 

[edmoor]

De logica van Office VBA en OpenOffice Basic is hetzelfde maar de objecten en de benadering er van is totaal anders. Dat gaat dus niet werken.
Zie ook:
https://wiki.openoffice.org/wiki/Documentation/FAQ/Macros/Can_I_use_my_Microsoft_Office_macros?