#1 Le 14/08/2008, à 14:21
- Mornagest
Transcrire une macro VBA en API, c'est... possible ?
Je sens que je vais avoir peur 
j'ai besoin d'une macro dans le cadre de mon boulot, et comme un con, je n'ai pas pensé que celle-ci ne serait pas compatible avec OpenOffice. J'ai essayé la version 2.4 ainsi que la 3.0, rien n'y fait, pas moyen de la lancer, il ne la détecte pas depuis un autre tableau Calc.
Du coup, je me suis dit que je pourrais peut-être la retranscrire, mais quand j'ai vu ça
Rem Attribute VBA_ModuleType=VBAUnknown
Option VBASupport 1
'Version du 25 août 1998
'dessin de courbes de toxicité et bootstrap pour calcul des intervalles de confiance
'la procédure de régression non linéaire (pour la logistique) s'inspire grandement
'de l'algorithme de Eric Vindimian (INERIS, France) selon la procédure de Marquardt
'=version modifiable de toxw97_g.xla
'
'faire remplacer toxw97_g.xls par toxw97_g.xla
'
'Dessiner des courbes de toxicité
Sub DessinDeCourbesDeToxicité()
entreefichier
taillebis
Workbooks("toxw97_g.xls").DialogSheets("dialog1").Show
End Sub
Sub entreefichier()
Dim fichier, feuille As String
Dim nligne, nrep, nconc, nboot, boot As Integer
ActiveSheet.Select
Cells.Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = "dessin"
Sheets("dessin").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub taillebis()
Dim i, j As Integer
i = 1
k = 1
Sheets("dessin").Select
champ = Sheets("dessin").Cells(1, 1).Value
Do While champ <> ""
som = 0
rep = 0
conc = champ
Cells(1, k + 4).Value = conc
Do Until champ <> conc
champ = Cells(i + 1, 1).Value
som = som + Cells(i, 2).Value
i = i + 1
rep = rep + 1
Loop
Cells(2, k + 4).Value = som / rep
k = k + 1
Loop
Sheets("dessin").Select
Range("A1:B1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
'Plage("A1").Sélectionner
'CelluleActive.FormuleL1C1 = "Longueur"
Cells(1, 1).Value = "Longueur"
'Plage("A2").Sélectionner
'CelluleActive.FormuleL1C1 = "Nconcentrations"
Cells(2, 1).Value = "Nconcentrations"
Cells(1, 2).Value = i - 1
Cells(2, 2).Value = k - 1
End Sub
Sub dessinchoixsuite()
Workbooks("toxw97_g.xls").DialogSheets("dialog4").Show
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(2) = xlOn Then
interpolbis
interpolbissuite
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(3) = xlOn Then
regcarrebis
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(1) = xlOn Then
Workbooks("toxw97_g.xls").DialogSheets("dialog5").Show
logitbis
logitbis2
End If
dessin
presentationfin
End Sub
Sub ordonneebis()
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(1) = xlOn Then
ordoref = InputBox("quelle est la valeur théorique des témoins ?")
Sheets("dessin").Cells(3, 2).Value = ordoref
End If
End Sub
Sub logitbis()
Dim taillog, zonelog, zonelogbis As Range
Dim zoneadlog, zonebisadlog, echan As String
Dim i, err As Integer
Dim x(1000), Y(1000), par(4), maxim
Sheets("dessin").Select
'initialisation des paramètres de la logistique
If Cells(3, 4).Value = 1 Then
Cells(3, 6).Value = Cells(2, 5).Value
Cells(3, 8).Value = Cells(1, 4).Value
Cells(3, 10).Value = Cells(2, 4).Value
End If
'Plage("E3").Sélectionner
'CelluleActive.FormuleL1C1 = "max="
Cells(3, 5).Value = "max="
Range("E3").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Cells(3, 6).Value = Cells(2, 5).Value
If Cells(3, 4).Value = "" Then
conc = Cells(2, 2).Value
'recherche du maximum'
maxim = 0
For i = 1 To conc
If (Cells(2, i + 4).Value > maxim) Then maxim = Cells(2, i + 4).Value
Next i
nx = 0
moyx = 0
For i = 1 To conc
If (Cells(1, i + 4).Value * Cells(2, i + 4).Value > 0) And (maxim > Cells(2, i + 4).Value) Then moyx = moyx + Log(Cells(1, i + 4).Value)
If (Cells(1, i + 4).Value * Cells(2, i + 4).Value > 0) And (maxim > Cells(2, i + 4).Value) Then nx = nx + 1
Next i
If nx = 0 Then
MsgBox "Attention : la modélisation logistique est impossible !"
Cells(3, 6).Value = 0
Cells(3, 8).Value = 0
Cells(3, 10).Value = 0
logitbis2
Exit Sub
End If
If nx > 0 Then
moyx = moyx / nx
End If
ny = 0
moyy = 0
For j = 1 To conc
If (Cells(1, j + 4).Value * Cells(2, j + 4).Value > 0) And (maxim > Cells(2, j + 4).Value) Then t = Log(maxim / Cells(2, j + 4).Value - 1)
If (Cells(1, j + 4).Value * Cells(2, j + 4).Value > 0) And (maxim > Cells(2, j + 4).Value) Then moyy = moyy + t
If (Cells(1, j + 4).Value * Cells(2, j + 4).Value = 0) Then moyy = moyy + Log(1000)
If maxim = Cells(2, j + 4).Value Then moyy = moyy + Log(0.01)
Next j
moyy = moyy / conc
somcar = 0
cov = 0
For i = 1 To conc
If Cells(1, i + 4).Value * Cells(2, i + 4).Value > 0 Then transf = maxim / Cells(2, i + 4).Value - 1
If Cells(1, i + 4).Value * Cells(2, i + 4).Value > 0 Then If transf > 0 Then somcar = somcar + (Log(Cells(1, i + 4).Value) - moyx) ^ 2
If Cells(1, i + 4).Value * Cells(2, i + 4).Value > 0 Then If transf > 0 Then cov = cov + (Log(Cells(1, i + 4).Value) - moyx) * (Log(maxim / Cells(2, i + 4).Value * 1.01 - 1) - moyy)
Next i
If somcar = 0 Then Cells(3, 8).Value = 2
If somcar > 0 Then Cells(3, 8).Value = cov / somcar
If Cells(3, 8) < 0 Then Cells(3, 8).Value = 2
If Cells(3, 8).Value > 0.001 Then Cells(3, 10).Value = Exp((Cells(3, 8).Value * moyx - moyy) / Cells(3, 8).Value)
If Cells(3, 8).Value <= 0.001 Then Cells(3, 10).Value = 10000000
End If
'Plage("G3").Sélectionner
'CelluleActive.FormuleL1C1 = "Hill="
Cells(3, 7).Value = "Hill"
Range("G3").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
' Plage("H3").Sélectionner
' CelluleActive.FormuleL1C1 = "2"
'Plage("I3").Sélectionner
'CelluleActive.FormuleL1C1 = "CL50="
Cells(3, 9).Value = "CE50"
Range("J3").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
'Cellules(3; 10).Valeur = (Cellules(Cellules(1; 2).Valeur + 3; 1).Valeur) / 2
tot = Cells(1, 2).Value
Set zonelog = Range(Cells(4, 5), Cells(4 + tot - 1, 5))
Range("E4").Select
ActiveCell.FormulaR1C1 = "=L3C6/(1+(LC(-4)/L3C10)^L3C8)"
Range("E4").Select
Selection.AutoFill Destination:=zonelog, Type:= _
xlFillDefault
Set zonelog = Range(Cells(4, 6), Cells(4 + tot - 1, 6))
Range("F4").Select
ActiveCell.FormulaR1C1 = "=(LC(-1)-LC(-4))^2"
Range("F4").Select
Selection.AutoFill Destination:=zonelog, Type:= _
xlFillDefault
Range("G6").Select
ActiveCell.FormulaR1C1 = "s="
Range("G6").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
zonelogad = zonelog.Address(ReferenceStyle:=xlR1C1)
Range("H6").Select
Selection.FormulaArray = "=racine(SOMME(" & zonelogad & ")/(L1C2-3))"
' Application.ExécuterMacroExcel4 ChaîneCaractères:="SOLVER.xLA!SOLVEUR.OK(!L6C8;2;0;(!L3C6;!L3C8;!L3C10))"
'Application.ExécuterMacroExcel4 ChaîneCaractères:="SOLVER.xLA!SOLVEUR.RESOUDRE()"
'Touches Chaîne:="{ENTREE}"
'j'appelle la procedure caltox de Marquardt
Call AUTPAR(par())
ntot = Cells(1, 2).Value
For j = 1 To ntot
x(j) = Cells(3 + j, 1).Value
Next
For i = 1 To ntot
Y(i) = Cells(i + 3, 2)
Next
Call CALTOX(x(), Y(), par(), err)
Cells(3, 6).Value = par(1)
Cells(3, 8).Value = par(2)
Cells(3, 10).Value = par(3)
If err = 1 Then
MsgBox "l'algorithme n'a pas convergé ! éventuellement initialiser à la main les paramètres de la logistique."
Exit Sub
End If
'reprise de la macro ecotest classique
i = 1
somcar = 0
For i = 1 To tot
somcar = somcar + Cells(4 + i - 1, 2).Value * Cells(4 + i - 1, 2).Value
Next i
Range("G7").Select
ActiveCell.FormulaR1C1 = "somcar="
Range("G7").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Cells(7, 8).Value = somcar
'Plage("I6").Sélectionner
'CelluleActive.FormuleL1C1 = "R²="
Cells(6, 9).Value = "R²="
Range("G6").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
'Plage("J6").Sélectionner
'Sélection.FormuleMatricielle = "=1-H6*H6*(B1-3)/H7"
Cells(6, 10).Value = 1 - Cells(6, 8).Value * Cells(6, 8).Value * (Cells(1, 2).Value - 3) / Cells(7, 8).Value
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(1) = xlOn Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=L3C2"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(2) = xlOn Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=L3C6"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(3) = xlOn Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=L2C5"
End If
Range("G8").Select
ActiveCell.FormulaR1C1 = "IC5"
Range("H8").Select
ActiveCell.FormulaR1C1 = "IC10"
Range("I8").Select
ActiveCell.FormulaR1C1 = "IC20"
Range("J8").Select
ActiveCell.FormulaR1C1 = "IC50"
Range("K8").Select
ActiveCell.FormulaR1C1 = "max"
Range("L8").Select
ActiveCell.FormulaR1C1 = "Hill"
Range("G9").Select
ActiveCell.FormulaR1C1 = "=L3C10*(L3C6/L1C3/0,95-1)^(1/L3C8)"
Range("H9").Select
ActiveCell.FormulaR1C1 = "=L3C10*(L3C6/L1C3/0,9-1)^(1/L3C8)"
Range("I9").Select
ActiveCell.FormulaR1C1 = "=L3C10*(L3C6/L1C3/0,8-1)^(1/L3C8)"
Range("J9").Select
ActiveCell.FormulaR1C1 = "=L3C10*(L3C6/L1C3/0,5-1)^(1/L3C8)"
Range("K9").Select
ActiveCell.FormulaR1C1 = "=L(-6)C(-5)"
Range("L9").Select
ActiveCell.FormulaR1C1 = "=L(-6)C(-4)"
Range("G9:L9").Select
Selection.Copy
Range("G10:L10").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub logitbis2()
conc = Cells(2, 2).Value
Set zonelogbis = Range(Cells(1, 5), Cells(1, 5 + conc - 1))
zonelogbis.Select
Selection.Copy
ActiveWindow.LargeScroll ToRight:=-1
Range("H23").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=True
ActiveWindow.SmallScroll ToRight:=3
Range("J23").Select
ActiveCell.FormulaR1C1 = "=L3C6/(1+(LC(-2)/L3C10)^L3C8)"
conc = Cells(2, 2).Value
Set taillog = Range(Cells(23, 10), Cells(23 + conc - 1, 10))
Range("J23").Select
Selection.AutoFill Destination:=taillog, Type:= _
xlFillDefault
tot = Cells(1, 2).Value
maxim = Cells(3 + tot, 1).Value
For i = 0 To 100
Cells(23 + i, 12).Value = i / 100 * maxim
Next i
Range("M23").Select
ActiveCell.FormulaR1C1 = "=L3C6/(1+(LC(-1)/L3C10)^L3C8)"
Set zonebislog = Range(Cells(23, 13), Cells(23 + 100, 13))
Range("M23").Select
Selection.AutoFill Destination:=zonebislog, Type:= _
xlFillDefault
End Sub
Sub interpolbis()
Dim zoneconc As Range
Sheets("dessin").Select
conc = Cells(2, 2).Value
Set zoneconc = Range(Cells(1, 5), Cells(2, 5 + conc - 1))
zoneconc.Select
Selection.Copy
Range("H23").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=True
End Sub
Sub interpolbissuite()
Sheets("dessin").Select
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(1) = xlOn Then
Range("C2").Select
ActiveCell.FormulaR1C1 = "=L3C2"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(2) = xlOn Then
Range("C2").Select
ActiveCell.FormulaR1C1 = "=L2C5"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(3) = xlOn Then
Range("C2").Select
ActiveCell.FormulaR1C1 = "=L2C5"
End If
Range("Q7:S7").Select
Selection.Clear
'calcul de IC5
seuil = (100 - 5) / 100 * Cells(2, 3).Value
i = 1
conc = Cells(2, 5).Value
Do While conc > seuil
conc = Cells(2, 4 + i + 1).Value
i = i + 1
Loop
If i < Cells(2, 2).Value + 1 Then
deltaeffet = Cells(2, 4 + i).Value - Cells(2, 4 + i - 1).Value
deltaconc = Cells(1, 4 + i).Value - Cells(1, 4 + i - 1).Value
x = Cells(1, 4 + i - 1).Value + (seuil - Cells(2, 4 + i - 1).Value) * deltaconc / deltaeffet
Range("Q6").Select
ActiveCell.FormulaR1C1 = "IC5"
Cells(7, 17).Value = x
End If
'calcul de IC10
seuil = (100 - 10) / 100 * Cells(2, 3).Value
i = 1
conc = Cells(2, 5).Value
Do While conc > seuil
conc = Cells(2, 4 + i + 1).Value
i = i + 1
Loop
If i < Cells(2, 2).Value + 1 Then
deltaeffet = Cells(2, 4 + i).Value - Cells(2, 4 + i - 1).Value
deltaconc = Cells(1, 4 + i).Value - Cells(1, 4 + i - 1).Value
x = Cells(1, 4 + i - 1).Value + (seuil - Cells(2, 4 + i - 1).Value) * deltaconc / deltaeffet
Range("R6").Select
ActiveCell.FormulaR1C1 = "IC10"
Cells(7, 18).Value = x
End If
'calcul de IC20
seuil = (100 - 20) / 100 * Cells(2, 3).Value
i = 1
conc = Cells(2, 5).Value
Do While conc > seuil
conc = Cells(2, 4 + i + 1).Value
i = i + 1
Loop
If i < Cells(2, 2).Value + 1 Then
deltaeffet = Cells(2, 4 + i).Value - Cells(2, 4 + i - 1).Value
deltaconc = Cells(1, 4 + i).Value - Cells(1, 4 + i - 1).Value
x = Cells(1, 4 + i - 1).Value + (seuil - Cells(2, 4 + i - 1).Value) * deltaconc / deltaeffet
Range("S6").Select
ActiveCell.FormulaR1C1 = "IC20"
Cells(7, 19).Value = x
End If
'calcul de IC50
seuil = (100 - 50) / 100 * Cells(2, 3).Value
i = 1
conc = Cells(2, 5).Value
Do While conc > seuil
conc = Cells(2, 4 + i + 1).Value
i = i + 1
Loop
If i < Cells(2, 2).Value + 1 Then
deltaeffet = Cells(2, 4 + i).Value - Cells(2, 4 + i - 1).Value
deltaconc = Cells(1, 4 + i).Value - Cells(1, 4 + i - 1).Value
x = Cells(1, 4 + i - 1).Value + (seuil - Cells(2, 4 + i - 1).Value) * deltaconc / deltaeffet
Range("T6").Select
ActiveCell.FormulaR1C1 = "IC50"
Cells(7, 20).Value = x
End If
Range("Q5").Select
ActiveCell.FormulaR1C1 = "Interpolation linéaire"
Range("Q6:T6").Select
Selection.Font.Bold = True
Range("Q5").Select
Selection.Font.Bold = True
i = 1
somcar = 0
tot = Cells(1, 2).Value
For i = 1 To tot
somcar = somcar + Cells(4 + i - 1, 2).Value * Cells(4 + i - 1, 2).Value
Next i
Cells(10, 18).Value = somcar
k = 1
j = 1
somresid = 0
champ = Cells(4, 1).Value
Do While champ <> ""
conc = champ
Cells(1, k + 4).Value = conc
Do Until champ <> conc
champ = Cells(j + 4, 1).Value
somresid = somresid + (Cells(j + 4 - 1, 2).Value - Cells(2, k + 4).Value) ^ 2
j = j + 1
Loop
k = k + 1
Loop
Cells(11, 18).Value = somresid
Cells(11, 19).Value = (somresid / Cells(1, 2).Value) ^ 0.5
Cells(12, 18).Value = 1 - Cells(11, 18).Value / Cells(10, 18).Value
End Sub
Sub regcarrebis()
Dim zonecarre, zonecarre2, zonebisreg, tailreg As Range
Dim zonecarread, zonecarread2, zonecarread3 As String
Dim cham, maximal As Variant
Sheets("dessin").Select
maxi = InputBox("à quel % de la concentration maximale s'arrêter pour le calcul de la régression polynomiale ?")
maximal = Cells(Cells(1, 2).Value + 3, 1).Value * (maxi + 1) / 100
i = 5
tot = 0
cham = Cells(4, 1).Value
If maxi < 100 Then
Do While cham < maximal
cham = Cells(i, 1).Value
i = i + 1
tot = tot + 1
Loop
Else: tot = Cells(1, 2).Value
End If
Set zonecarre = Range(Cells(4, 4), Cells(4 + tot - 1, 4))
zonecarre.Select
Range("D4").Select
ActiveCell.FormulaR1C1 = "=LC(-3)*LC(-3)"
Range("D4").Select
Selection.AutoFill Destination:=zonecarre, Type:= _
xlFillDefault
Set zonecarre = Range(Cells(4, 3), Cells(4 + tot - 1, 3))
zonecarre.Select
Range("C4").Select
ActiveCell.FormulaR1C1 = "=LC(-2)"
Range("C4").Select
Selection.AutoFill Destination:=zonecarre, Type:= _
xlFillDefault
Set zonecarre = Range(Cells(4, 2), Cells(4 + tot - 1, 2))
zonecarread = zonecarre.Address(ReferenceStyle:=xlR1C1)
Set zonecarre2 = Range(Cells(4, 3), Cells(4 + tot - 1, 4))
zonecarre2ad = zonecarre2.Address(ReferenceStyle:=xlR1C1)
Range("M6:O9").Select
Selection.FormulaArray = "=droitereg(" & zonecarread & ";" & zonecarre2ad & ";VRAI;VRAI)"
Range("M6:O9").Select
Selection.Copy
Range("M11:O14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(1) = xlOn Then
Range("C3").Select
ActiveCell.FormulaR1C1 = "=L3C2"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(2) = xlOn Then
Range("C3").Select
ActiveCell.FormulaR1C1 = "=L2C5"
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog4").OptionButtons(3) = xlOn Then
Range("C3").Select
ActiveCell.FormulaR1C1 = "=L2C5"
End If
Range("M16").Select
ActiveCell.FormulaR1C1 = "IC5"
Range("M17").Select
ActiveCell.FormulaR1C1 = "=(-L11C14-RACINE(L11C14*L11C14-4*L11C13*(L11C15-0,95*L3C3)))/(2*L11C13)"
Range("N16").Select
ActiveCell.FormulaR1C1 = "IC10"
Range("N17").Select
ActiveCell.FormulaR1C1 = "=(-L11C14-RACINE(L11C14*L11C14-4*L11C13*(L11C15-0,9*L3C3)))/(2*L11C13)"
Range("O16").Select
ActiveCell.FormulaR1C1 = "IC20"
Range("O17").Select
ActiveCell.FormulaR1C1 = "=(-L11C14-RACINE(L11C14*L11C14-4*L11C13*(L11C15-0,8*L3C3)))/(2*L11C13)"
Range("P16").Select
ActiveCell.FormulaR1C1 = "IC50"
Range("P17").Select
ActiveCell.FormulaR1C1 = "=(-L11C14-RACINE(L11C14*L11C14-4*L11C13*(L11C15-0,5*L3C3)))/(2*L11C13)"
conc = Cells(2, 2).Value
Set zonebisreg = Range(Cells(1, 5), Cells(1, 5 + conc - 1))
zonebisreg.Select
Selection.Copy
'FenêtreActive.DéfilerRapidement VersDroite:=-1
Range("H23").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=True
'FenêtreActive.DéfilerLentement VersDroite:=3
Range("K23").Select
ActiveCell.FormulaR1C1 = "=L6C15+L6C14*LC(-3)+L6C13*LC(-3)*LC(-3)"
conc = Cells(2, 2).Value
Set tailreg = Range(Cells(23, 11), Cells(23 + conc - 1, 11))
Range("K23").Select
Selection.AutoFill Destination:=tailreg, Type:= _
xlFillDefault
For i = 0 To 100
Cells(23 + i, 14).Value = i / 100 * maximal
Next i
Range("O23").Select
ActiveCell.FormulaR1C1 = "=L6C15+L6C14*LC(-1)+L6C13*LC(-1)*LC(-1)"
Set zonebisreg = Range(Cells(23, 15), Cells(23 + 100, 15))
Range("O23").Select
Selection.AutoFill Destination:=zonebisreg, Type:= _
xlFillDefault
End Sub
Sub dessin()
Dim interp, reg, logi, zone, zonebis As Range
Sheets("dessin").Select
conc = Cells(2, 2).Value
Set interp = Range(Cells(23, 8), Cells(23 + conc - 1, 9))
Set reg = Range(Cells(23, 14), Cells(123, 15))
Set logi = Range(Cells(23, 12), Cells(123, 13))
tot = Cells(1, 2).Value
Set zone = Range(Cells(4, 1), Cells(4 + tot - 1, 2))
ActiveSheet.ChartObjects.Add(369.75, 133.5, 342.75, 144.75). _
Select
Application.CutCopyMode = False
ActiveChart.ChartWizard Source:=zone, _
Gallery:=xlXYScatter, Format:=1, PlotBy:=xlColumns _
, CategoryLabels:=1, SeriesLabels:=0, HasLegend _
:=1
With ActiveChart.ChartArea.Font
.Name = "Times New Roman"
.FontStyle = "Normal"
.Size = 12
.Bold = True
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With ActiveChart.SeriesCollection(1)
.MarkerBackgroundColorIndex = 2
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlCircle
.Smooth = False
.Name = "=""observations"""
End With
With ActiveChart.SeriesCollection(1).Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With ActiveChart.PlotArea.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With ActiveChart.PlotArea.Interior
.ColorIndex = xlNone
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = False
End With
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = False
End With
nbcourbe = 1
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(1) = xlOn Then
ActiveChart.SeriesCollection.Add Source:=logi, _
Rowcol:=xlColumns, SeriesLabels:=False, _
CategoryLabels:=True, Replace:=False
With ActiveChart.SeriesCollection(2).Border
.ColorIndex = 3
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(2)
.MarkerBackgroundColorIndex = 26
.MarkerForegroundColorIndex = 26
.MarkerStyle = xlNone
.Smooth = True
.Name = "=""logistique"""
End With
nbcourbe = 2
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(2) = xlOn Then
ActiveChart.SeriesCollection.Add Source:=interp, _
Rowcol:=xlColumns, SeriesLabels:=False, _
CategoryLabels:=True, Replace:=False
With ActiveChart.SeriesCollection(nbcourbe + 1).Border
.ColorIndex = 4
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(nbcourbe + 1)
.MarkerBackgroundColorIndex = 26
.MarkerForegroundColorIndex = 26
.MarkerStyle = xlNone
.Smooth = False
.Name = "=""interpolation"""
End With
nbcourbe = nbcourbe + 1
End If
If Workbooks("toxw97_g.xls").DialogSheets("dialog1").CheckBoxes(3) = xlOn Then
ActiveChart.SeriesCollection.Add Source:=reg, _
Rowcol:=xlColumns, SeriesLabels:=False, _
CategoryLabels:=True, Replace:=False
With ActiveChart.SeriesCollection(nbcourbe + 1).Border
.ColorIndex = 5
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(nbcourbe + 1)
.MarkerBackgroundColorIndex = 26
.MarkerForegroundColorIndex = 26
.MarkerStyle = xlNone
.Smooth = True
.Name = "=""polynôme"""
End With
End If
End Sub
Sub presentationfin()
'FenêtreActive.DéfilerLentement VersDroite:=4
Range("I3").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("E3:J3").Select
Selection.Font.Bold = True
Range("G8:L9").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Selection.Font.Bold = True
'FenêtreActive.DéfilerLentement VersDroite:=5
'FenêtreActive.DéfilerLentement VersBas:=7
Range("M11:P11").Select
Selection.Font.Bold = True
Range("M16:P16").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Selection.Font.Bold = True
Range("M10").Select
ActiveCell.FormulaR1C1 = "Régression polynomiale"
Range("M10").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Selection.Copy
Range("K13").Select
ActiveSheet.Paste
Range("M10").Select
Application.CutCopyMode = False
Selection.ClearContents
'FenêtreActive.DéfilerLentement VersBas:=7
'FenêtreActive.DéfilerRapidement VersDroite:=-1
'FenêtreActive.DéfilerRapidement VersBas:=-1
'FenêtreActive.DéfilerLentement VersDroite:=7
'FenêtreActive.DéfilerRapidement VersDroite:=-2
Columns("A:G").Select
Range("A2").Activate
Selection.Insert Shift:=xlToRight
ActiveSheet.DrawingObjects("Graphique 1").Select
Selection.Left = 405
Selection.Top = 27.75
Selection.Left = 37.5
Selection.Top = 44.25
Range("B2").Select
ActiveCell.FormulaR1C1 = "Les résultats sont en dessous du graphique"
Range("B2").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlNone
.ColorIndex = xlAutomatic
End With
Range("a18").Select
ActiveCell.FormulaR1C1 = "Logistique"
Range("a21").Select
ActiveCell.FormulaR1C1 = "Polynôme"
Range("a24").Select
ActiveCell.FormulaR1C1 = "Interpolation"
Range("N8:S9").Select
Selection.Copy
Range("B17").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("T16:W17").Select
Selection.Copy
Range("B20").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("X6:AA7").Select
Selection.Copy
Range("B23").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A19:G19").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A24:G24").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("N6:Q6").Select
Selection.Copy
Range("B20").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("T13").Select
Selection.Copy
Range("E25").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("U13").Select
Selection.Copy
Range("C25").Select
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("B25").Select
ActiveCell.FormulaR1C1 = "s="
Range("D25").Select
ActiveCell.FormulaR1C1 = "R²="
Range("B25").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("D25").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("B25").Select
Selection.Copy
Range("B30").Select
ActiveSheet.Paste
Range("D25").Select
Selection.Copy
Range("D30").Select
ActiveSheet.Paste
Range("Y12").Select
Selection.Copy
Range("E30").Select
ActiveSheet.Paste
Range("Z11").Select
Selection.Copy
Range("C30").Select
ActiveSheet.Paste
Range("B17:G17").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End With
Range("B22:E22").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = xlHorizontal
End Withj'ai un peu hésité (il en reste encore plein, plus bas...).
Est-ce seulement possible, ou dois-je me pendre et aller bosser sur le PC d'un collègue (équipé d'Office 2000) ?
Merci d'avance !
N'oubliez pas de consulter la documentation pour vous donner un coup de main !
Merci de modifier le premier message de votre sujet pour ajouter [Résolu] lorsque votre problème l'est :)
Xubuntu 20.04 sur deux ordinateurs, zéro souci. Passez à Xubuntu ;)
Hors ligne
#2 Le 14/08/2008, à 16:13
- Mornagest
Re : Transcrire une macro VBA en API, c'est... possible ?
Sinon, est-ce qu'il existe un moyen d'utiliser une macro VBA ? J'ai vaguement lu que la version Novell d'OpenOffice le permet, mais je n'ai pas l'impression qu'elle soit gratuite ?
Quelqu'un peut m'éclairer à ce sujet ? 
N'oubliez pas de consulter la documentation pour vous donner un coup de main !
Merci de modifier le premier message de votre sujet pour ajouter [Résolu] lorsque votre problème l'est :)
Xubuntu 20.04 sur deux ordinateurs, zéro souci. Passez à Xubuntu ;)
Hors ligne
#3 Le 14/08/2008, à 16:41
- solho
Re : Transcrire une macro VBA en API, c'est... possible ?
Salut...
Ma réponse ne te sera pas d'un grand secours, mais les macros d'office ne sont pas compatible avec celles d'open office (le vba de l'un n'est pas tout à fait le même de l'autre...).
Quelques extrait d'un "gros" pavé que j'ai commencé à lire sur les macros et api:
"La conversion des documents Word et Excel est effectué généralement correctement; en revanche, les macros VBA dans ces documents ne sont pas convertie en OOobasic. La raison est qu'il n'y a pas d'équivalence simple entre les deux langages ... les instructions du langage OOobasic ... sont trés similaires et souvent identiques à celles de VBA. Il existe toutefois des differences de détails, qui peuvent nécessiter une modification de l'algorithme."
un encart qui peut t'aider (?):
"Migration de VBA à OOobasic
James M. Thompson à écrit un document de 60 pages qui présente le portage de Excel/VBA vers Calc/Basic, du point de vue d'un programmeur VBA : "VBA to StarBasic cross reference". Ce document n'existe qu'en anglais, et la dernière version en est disponible sur le site d'OpenOffice.org.
-> http://documentation.openoffice.org/HOW_TO/
La version 8 de StarOffice (basé sur la version 2 d'OOo) offre un outil d'aide à la conversion de macros VBA vers OOoBasic. Nous n'avons pas eu l'ocassion de le tester."
Extraits de "Programmation OpenOffice.org, Macros et API" aux éditions Eyrolles.
En espérant que cela t'éclaire...
Amicalement
Dernière modification par solho (Le 14/08/2008, à 16:44)
Don't Worry... Be Linux!
Ubuntu 10.10 & 11.04
quelques mémentos.
Hors ligne
#4 Le 14/08/2008, à 19:16
- Mornagest
Re : Transcrire une macro VBA en API, c'est... possible ?
Je lirai à tête reposée, là j'ai passé mon après-midi à chercher s'il n'existait pas une méthode plus directe... apparemment, ça va être du rechercher/remplacer pour toute la macro, yipee
Enfin, merci beaucoup pour le lien en tout cas je donnerai des nouvelles quand j'aurai... réussi à transcrire ce bordel 
N'oubliez pas de consulter la documentation pour vous donner un coup de main !
Merci de modifier le premier message de votre sujet pour ajouter [Résolu] lorsque votre problème l'est :)
Xubuntu 20.04 sur deux ordinateurs, zéro souci. Passez à Xubuntu ;)
Hors ligne