Adapter une macro excel en macro pour oppen o
weirstrass
-
OOoForum Messages postés 3871 Date d'inscription Statut Membre Dernière intervention -
OOoForum Messages postés 3871 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
J'aimerai adapter cette macro excel à open office . Quelqu'un pourrait-il m'aider?
Sub Feuil1
Rem Option Explicit
Rem
Rem Sub rechSomme()
Rem Dim n(1 To 4) As Long, maxn(1 To 4) As Long, i As Long, t As Long, nbsol As Long, fini As Boolean
Rem Dim nbmaxsol As Long
Rem ' init
Rem nbmaxsol = 1000
Rem For i = 1 To 4
Rem maxn(i) = Cells(65536, i).End(xlUp).Row
Rem n(i) = 2
Rem Next i
Rem Range("H2:K65536").ClearContents
Rem '
Rem Application.ScreenUpdating = False
Rem i = 4: n(4) = 1
Rem Do
Rem n(4) = n(4) + 1
Rem For i = 4 To 2 Step -1
Rem If n(i) > maxn(i) Then
Rem n(i) = 2
Rem n(i - 1) = n(i - 1) + 1
Rem Else
Rem Exit For
Rem End If
Rem Next i
Rem If n(1) > maxn(1) Then fini = True
Rem If Not fini Then
Rem t = 0
Rem For i = 1 To 4
Rem t = t + Cells(n(i), i)
Rem Next i
Rem If t = [F2] Then
Rem nbsol = nbsol + 1
Rem For i = 1 To 4
Rem [G1].Offset(nbsol, i) = Cells(n(i), i)
Rem Next i
Rem
Rem End If
Rem End If
Rem If nbsol = nbmaxsol Then
Rem MsgBox ("nbmaxsol atteint")
Rem fini = True
Rem End If
Rem If fini And nbsol < nbmaxsol Then MsgBox (nbsol & " solutions.")
Rem Loop Until fini
Rem Application.ScreenUpdating = True
Rem End Sub
Rem
End Sub
MERCI !!
J'aimerai adapter cette macro excel à open office . Quelqu'un pourrait-il m'aider?
Sub Feuil1
Rem Option Explicit
Rem
Rem Sub rechSomme()
Rem Dim n(1 To 4) As Long, maxn(1 To 4) As Long, i As Long, t As Long, nbsol As Long, fini As Boolean
Rem Dim nbmaxsol As Long
Rem ' init
Rem nbmaxsol = 1000
Rem For i = 1 To 4
Rem maxn(i) = Cells(65536, i).End(xlUp).Row
Rem n(i) = 2
Rem Next i
Rem Range("H2:K65536").ClearContents
Rem '
Rem Application.ScreenUpdating = False
Rem i = 4: n(4) = 1
Rem Do
Rem n(4) = n(4) + 1
Rem For i = 4 To 2 Step -1
Rem If n(i) > maxn(i) Then
Rem n(i) = 2
Rem n(i - 1) = n(i - 1) + 1
Rem Else
Rem Exit For
Rem End If
Rem Next i
Rem If n(1) > maxn(1) Then fini = True
Rem If Not fini Then
Rem t = 0
Rem For i = 1 To 4
Rem t = t + Cells(n(i), i)
Rem Next i
Rem If t = [F2] Then
Rem nbsol = nbsol + 1
Rem For i = 1 To 4
Rem [G1].Offset(nbsol, i) = Cells(n(i), i)
Rem Next i
Rem
Rem End If
Rem End If
Rem If nbsol = nbmaxsol Then
Rem MsgBox ("nbmaxsol atteint")
Rem fini = True
Rem End If
Rem If fini And nbsol < nbmaxsol Then MsgBox (nbsol & " solutions.")
Rem Loop Until fini
Rem Application.ScreenUpdating = True
Rem End Sub
Rem
End Sub
MERCI !!
1 réponse
-
On ne peut pas adapter une macro en VBA car le Basic de OpenOffice.org est incompatible.
Voici une liste de ressources pour bien commencer votre apprentissage.