Can't run a VBA macro from MS Excel file

[musicnmore]

There is only one Macro I need to run, but OpenOffice 2.3 cannot run MS Office Macros (VBA)

How do I alter the Macro to run in Open Office?

That is the only thing that will keep me from using Open Office.

Any help would be greatly appreciated.

Rene

[Hagar Delest]

If the macro is not so long, you can try to rewrite it.

Else, you can try OxygenOffice : OxygenOffice Professional [OOOP or O2OP] on SourceForge.net or go-oo.org.

Thanks to add '[Solved]' in your first post title (edit button) if your issue has been fixed.

[musicnmore]

This is the whole macro, I am totally new to macro's, do not know a thing about them.

Sub ReformatStockList()
On Error GoTo theErr

Dim bDone As Boolean
Dim lRow As Long
Dim lNextItem As Long
Dim sUPC As String
Dim sCatNbr As String
Dim sLabel As String
Dim sTitleArtist As String
Dim sCommentsTracks As String
Dim sArtist As String
Dim sTitle As String
Dim sFormat As String
Dim sPrice As String
Dim sGenre As String
Dim sTracks As String
Dim sComments As String
Dim sCurrency As String
Dim sRelDate As String
Dim lPos As Long
Dim lAns As VbMsgBoxResult

lAns = MsgBox("Do you want to Reformat this Stock List?", vbQuestion + vbYesNo)
If lAns = vbNo Then
MsgBox "Stock List Update Canceled"
GoTo theExit
End If

[Hagar Delest]

That's only a small part of the macro I think. Try to post it in the Macro section of this forum.

[musicnmore]

Thanks.

Just one other question.
If I install OxygenOffice Professional [OOOP or O2OP] do I install it over OpenOffice 2.3 or can I un-install Open Offive 2.3?

Thanks for all your help.

Rene

[Hagar Delest]

For such similar applications, I think it's better to uninstall OOo first.

[musicnmore]

I successfully installed OxygenOffice, which states - It does support VBA Macro's but my Macro is still not working.

Anyone here that can help me?

Thanks,
Rene

[musicnmore]

I think this is the full Macro

Code: Select all

Option Explicit
Const UPC = 1
Const CAT = 2
Const LBL = 3
Const ARTTTL = 4
Const COMTRK = 5
Const FMT = 6
Const GEN = 7
Const PRC = 8
Const CUR = 9
Const REL = 10

Sub ReformatStockList()
    On Error GoTo theErr

    Dim bDone As Boolean
    Dim lRow As Long
    Dim lNextItem As Long
    Dim sUPC As String
    Dim sCatNbr As String
    Dim sLabel As String
    Dim sTitleArtist As String
    Dim sCommentsTracks As String
    Dim sArtist As String
    Dim sTitle As String
    Dim sFormat As String
    Dim sPrice As String
    Dim sGenre As String
    Dim sTracks As String
    Dim sComments As String
    Dim sCurrency As String
    Dim sRelDate As String
    Dim lPos As Long
    Dim lAns As VbMsgBoxResult
    
    lAns = MsgBox("Do you want to Reformat this Stock List?", vbQuestion + vbYesNo)
    If lAns = vbNo Then
        MsgBox "Stock List Update Canceled"
        GoTo theExit
    End If
    
    Application.ScreenUpdating = False
        
    'fix formatting
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
    End With
    
    'insert headers
    Cells(1, 1).EntireRow.Select
    Selection.Insert xlShiftDown
    
    Cells(1, UPC).Value = "UPC"
    Cells(1, CAT).Value = "Cat#"
    Cells(1, LBL).Value = "Label"
    Cells(1, ARTTTL).Value = "Artist/Title"
    Cells(1, COMTRK).Value = "Comments/Tracks"
    Cells(1, FMT).Value = "Format"
    Cells(1, GEN).Value = "Genre"
    Cells(1, PRC).Value = "Price"
    Cells(1, CUR).Value = "Currency"
    Cells(1, REL).Value = "Rel Date"
    Cells(1, 1).EntireRow.Font.Bold = True
    
    'format UPC and CatNbr columns as Text to eliminate exponential notation
    Cells(1, UPC).EntireColumn.NumberFormat = "@"
    Cells(1, CAT).EntireColumn.NumberFormat = "@"
        
    'format Price column as currency
    Cells(1, PRC).EntireColumn.NumberFormat = "#,##0.00"
    
    bDone = False
    lRow = 2
    While Not bDone
        Cells(lRow, 1).Activate
        If Not IsItem(lRow) Then
            'its not an item row so delete it
            Cells(lRow, 1).EntireRow.Delete Shift:=xlShiftUp
            If lRow > ActiveSheet.UsedRange.Rows.Count Then
                bDone = True
            End If
        Else
            If IsItem(lRow + 2) Then
                lNextItem = lRow + 2
            Else
                lNextItem = lRow + 3
                If Not IsItem(lRow + 3) And lRow > ActiveSheet.UsedRange.Rows.Count Then
                    bDone = True
                End If
            End If
            
            sUPC = ""
            sCatNbr = ""
            sLabel = ""
            sTitleArtist = ""
            sCommentsTracks = ""
            sFormat = ""
            sGenre = ""
            sPrice = ""
            sCurrency = ""
            sRelDate = ""
            sComments = ""
            sTracks = ""
        
            'figure out what is a catnbr, label and upc
            sCatNbr = Trim(Replace(CStr(Cells(lRow, 1).Value), Chr(160), " "))
            sLabel = Trim(Replace(CStr(Cells(lRow + 1, 1).Value), Chr(160), ""))
            If Not IsCatNbr(sCatNbr) Then
                sLabel = sCatNbr
                sCatNbr = ""
            End If
            
            If lNextItem = lRow + 3 Then
                sUPC = Trim(Replace(CStr(Cells(lRow + 2, 1).Value), Chr(160), ""))
            End If
            
            If sUPC = "" And IsNumeric(sLabel) Then
                sUPC = sLabel
                sLabel = ""
            End If
            
            sTitleArtist = CStr(Cells(lRow, 2).Value)
            
'            'split up title and artist
'            lPos = InStr(1, sTitleArtist, " - ")
'            If lPos = 0 Then
'                sTitle = sTitleArtist
'                sArtist = ""
'            Else
'                sArtist = Mid(sTitleArtist, 1, lPos - 1)
'                sTitle = Mid(sTitleArtist, lPos + 3, Len(sTitleArtist))
'            End If

            'get tracks and comments
            If Left(CStr(Cells(lRow + 1, 2).Value), 13) = "TRACKLISTING:" Then
                sTracks = CStr(Cells(lRow + 1, 2).Value)
                sComments = ""
            Else
                If lNextItem = lRow + 3 Then
                    sComments = CStr(Cells(lRow + 1, 2).Value)
                    If Left(CStr(Cells(lRow + 2, 2).Value), 13) = "TRACKLISTING:" Then
                        sTracks = CStr(Cells(lRow + 2, 2).Value)
                    End If
                End If
            End If
            sTracks = Replace(sTracks, Chr(160), "")
'            If Len(sTracks) > 14 Then
'                sTracks = Mid(sTracks, 15, Len(sTracks) - 15)
'            End If
            If sComments = "" Then
                sCommentsTracks = sTracks
            Else
                sCommentsTracks = sComments & " " & sTracks
            End If
            
            'get format
            sFormat = CStr(Cells(lRow, 3).Value)
            
            'get genre and release date
            sGenre = CStr(Cells(lRow + 1, 3).Value)
            If lNextItem = lRow + 3 Then
                sRelDate = CStr(Cells(lRow + 2, 3).Value)
            End If
            
            'get price, currency and tracks
            sPrice = Replace(CStr(Cells(lRow, 4).Value), Chr(160), "")
            sCurrency = Replace(CStr(Cells(lRow + 1, 4).Value), Chr(160), "")
            
            'add data to item first line
            Cells(lRow, UPC) = sUPC
            Cells(lRow, CAT) = sCatNbr
            Cells(lRow, LBL) = sLabel
            Cells(lRow, ARTTTL) = sTitleArtist
            Cells(lRow, COMTRK) = sCommentsTracks
            Cells(lRow, FMT) = sFormat
            Cells(lRow, GEN) = sGenre
            Cells(lRow, PRC) = sPrice
            Cells(lRow, CUR) = sCurrency
            Cells(lRow, REL) = sRelDate
            
            'delete items other rows
            Cells(lRow + 1, 1).EntireRow.Select
            Selection.Delete Shift:=xlShiftUp
            
            If lNextItem = lRow + 3 Then
                Cells(lRow + 1, 1).EntireRow.Delete Shift:=xlShiftUp
            End If
            lRow = lRow + 1
        End If
    Wend
    
    Cells.EntireRow.AutoFit
    Cells.EntireColumn.AutoFit
    Cells(1, 1).Activate
    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True
    
    MsgBox "Stock Format Complete"
    
theExit:
    Application.ScreenUpdating = True
    Exit Sub
theErr:
    MsgBox Err.Description
    Resume theExit
    
End Sub
Function IsCatNbr(sCatNbr As String) As Boolean
    On Error GoTo theErr
    
    Dim lPos As Long
    Dim sTest As String
    
    IsCatNbr = False
    
    If sCatNbr = "" Then
        IsCatNbr = True
    Else
        If IsNumeric(sCatNbr) Then
            IsCatNbr = True
        Else
            lPos = InStr(1, sCatNbr, " ")
            If lPos <> 0 Then
                sTest = Mid(sCatNbr, lPos + 1, Len(sCatNbr) - lPos)
                If IsNumeric(sTest) Then
                    IsCatNbr = True
                End If
            End If
        End If
    End If

theExit:
    Exit Function
theErr:
    MsgBox Err.Description
    Resume theExit
End Function
Function IsItem(lRow As Long) As Boolean
    On Error GoTo theErr
    
    Dim sPrice As String
    
    IsItem = False
    
    sPrice = Trim(Replace(CStr(Cells(lRow, 4).Value), Chr(160), ""))
    
    If IsNumeric(sPrice) Then
        IsItem = True
    End If
    
theExit:
    Exit Function
theErr:
    MsgBox Err.Description
    Resume theExit
End Function

[Hagar Delest]

Hi musicnmore, to avoid duplicates, I've moved your initial thread here and removed the new one you had created (since that in the end, it's not a Calc issue).

I've modified your post to get a code display, better to see the indents.

[musicnmore]

Thanks,
You've been very helpful.

Rene

[musicnmore]

I have more info.

Here’s the error message I get when I open the MS Excel file in OxygenOffice and run the macro.

“ A Scripting error Framework occurred while running the Basic Script Standard.modStock.IsCatNbr.

Message: Wrong number of parameters”

Hope that makes sense to the experts out there.
Rene

[musicnmore]

Is there anyone out here that can help me with this little problem

Or is this a very big problem?

Rene

[esperantisto]

VBA macros execution is not supported by regular OpenOffice.org. As for OxygenOffice, I think, you'd better address that team.

[Villeroy]

I'm pretty shure that the whole macro is obsolete unless you run it many times per hour. It should be possible to get the same transformation by a few built-in steps (template with styles and a pre-defined filter, then paste special and apply filter).

[rmcd]

I'm thoroughly confused about the status of, and plans for, VBA in Openoffice. In the openoffice.org wiki one finds this statement (it's been there for quite a while): "The VBA model is enabled by default in the current ooo-build."

Does this mean that

a) some version (perhaps a development version) of openoffice can run some version of VBA?
b) openoffice can load vba modules, but not necessarily execute them (this seems to be true)
c) there are plans for full-fledged vba compatability at some date in the future

While on the subject, when I try to run the "helloworldPython" script that ships with OO 2.3.1, I get a runtime exception. ?? This is under Windows.

Thanks, I'm not complaining, just trying to understand what's going on.