Vba sous open office 3.3

Bonjour,

j'ai une question à propos du transfert d'un programme sous vba d'excel vers open office calc 3.3.

Quand j'essaie d'exécuter à l'aide d'un bouton de macro, ce bouton fonctionne mais cela m'affiche

"Erreur d'exécution BASIC"
Type: com.sun.star.uno.runtimeException
Message: No ActiveWorkBook available'

Mais aussi: "erreur d'exécution BASIC
'423' Save As


C'est vraiment très important car ce programme est un élément central de ma thèse et le délai est très court pour le faire fonctionner.

Merci de m'aider.


PS: je met mon programme entier pour vous donner une idée.

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Dim maxFeuil As Integer
Dim maxLig As Long
Dim maxCol As Integer
Dim nomFichProg As String
Dim nomFich As String
Dim noClasseur As Long
Dim noFeuil As Long
Dim noLig As Long
Dim noCol As Long
Dim chemin As String
Dim Variation As Single
Dim nbEtats As Long
Dim nbTitres As Long
Dim rentRef As Single
Dim rentMax As Single
Dim alpha As Single
Dim tabDist() As Single
Dim nbClasseur As Long
Dim nbFeuil As Long
Dim nbLig As Long
Dim nbCol As Long


Sub Prog1()
'paramétrage EXCEL : nombre de feuilles à la création d'un classeur = 1
debut = Time()
Richesse = Worksheets("param").Cells(1, 2)
Variation = Worksheets("param").Cells(2, 2)
nbEtats = Worksheets("param").Cells(3, 2)
nbTitres = Worksheets("param").Cells(4, 2)
ReDim tabDist(nbTitres)
nomFichProg = ActiveWorkbook.Name

rentRef = InputBox("Rentabilité souhaitée ?")
alpha = InputBox("Seuil de faillite admissible ?")
nomFich = "r" & rentRef & "a" & alpha & "_"
Rows("9:10").Select
Selection.ClearContents
Cells(9, 1) = "Cas"
Cells(10, 1) = nomFich

maxFeuil = 255
maxLig = 65536
maxCol = 256 - nbTitres - 2
noClasseur = 1
noFeuil = 1
noLig = 1
noCol = 1
rentMax = -10000
chemin = ActiveWorkbook.Path & "\"
Workbooks.Add
ActiveSheet.Name = "P" & noFeuil
ActiveWorkbook.SaveAs Filename:= _
chemin & nomFich & noClasseur & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:= _
' chemin & nomFich & noClasseur & ".xls", FileFormat:= _
' xlNormal, CreateBackup:=False

dispatch 1, Richesse

ActiveWorkbook.Save
ActiveWorkbook.Close

ActiveWorkbook.Save

fin = Time
MsgBox "Traitement terminé en " & Int(fin - debut) & " jour(s) et " & Format((fin - debut) - Int(fin - debut), "hh:mm:ss")
End Sub

Function dispatch(noTitre, Richesse)

For k = 0 To Richesse Step Variation
tabDist(noTitre) = k
If noTitre < nbTitres Then
dispatch noTitre + 1, Richesse - k
Else
If noLig > maxLig Then
noLig = 1
noCol = noCol + nbTitres + 3
If noCol > maxCol Then
noCol = 1
noFeuil = noFeuil + 1
If noFeuil < maxFeuil Then
ActiveWorkbook.Save
'ajout d'une feuille
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "P" & noFeuil
Else
noFeuil = 1
ActiveWorkbook.Save
ActiveWorkbook.Close
'creation d'un classeur
noClasseur = noClasseur + 1
Workbooks.Add
ActiveSheet.Name = "P" & noFeuil
ActiveWorkbook.SaveAs Filename:= _
chemin & nomFich & noClasseur & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:= _
' chemin & nomFich & noClasseur & ".xls", FileFormat:= _
' xlNormal, CreateBackup:=False
End If
End If
End If

For i = 1 To nbTitres
Cells(noLig, noCol + i - 1) = tabDist(i)
Next

With Workbooks(nomFichProg).Worksheets("états")
proba = 0
rentMoy = 0
For i = 1 To nbEtats
rent = 0
For j = 1 To nbTitres
rent = rent + (Cells(noLig, noCol + j - 1) * .Cells(i, j))
Next
rentMoy = rentMoy + rent
If rent < rentRef Then proba = proba + 1
Next

rentMoy = rentMoy / nbEtats
proba = proba / nbEtats
End With

If proba > alpha Then
For i = 1 To nbTitres
Cells(noLig, noCol + i - 1) = ""
Next
noLig = noLig - 1
Else
If rentMoy > rentMax Then
rentMax = rentMoy
With Workbooks(nomFichProg).Worksheets("param")
For i = 1 To nbTitres
.Cells(9, i + 1) = "T" & i
.Cells(10, i + 1) = tabDist(i)
Next
End With
End If
End If
noLig = noLig + 1
End If
Next
End Function