Nel lontano 2000 ebbi la necessità di esporre il 'Rendimento medio' di un cliente in un programma che ho sviluppato per la gestione dei Clienti per Promotori Finanziari.
Siccome esisteva un foglio Excel con le formule giuste per effettuare il calcolo allora ho esportato sul foglio, a cominciare da una riga e colonna prestabiliti i valori dei movimenti e le rispettive date, quindi estraevo da una determinata cella il risultato del calcolo.
Ti propongo un esempio di quel passaggio:
Private Sub CalcolaRendimento()
Dim MyXL As Object
Dim WkBk As Object, ShFoglio As Object
Dim XlsFile As String, XlsFoglio As String, NomeFoglio As String
Dim Jy As Integer, dblRendimento As Double
Dim TabXY(5) As Long
On Error GoTo CalcolaRendERR
Me.WindowState = vbHourglass
DoEvents
TabXY(1) = 1000
TabXY(2) = 2000
TabXY(3) = 3000
TabXY(4) = 4000
TabXY(5) = 5555
'file Excel con le formule che mi servivano
XlsFile = App.Path & "\CkRendimento.xls"
'verifico la sua esistenza
If Dir(XlsFile) = "" Then
MsgBox "File Excel inesistente: " & XlsFile
Exit Sub
End If
'suo foglio con le formule che mi servivano
XlsFoglio = "Calcoli"
'apertura del file Excel
Set MyXL = GetObject(XlsFile)
Set WkBk = MyXL.Application.Workbooks(1)
'cerco il Foglio giusto
NomeFoglio = ""
'controllo l'esistenza del foglio desiderato: Calcoli
For Jy = 1 To WkBk.Sheets.Count 'per ogni foglio esistente
If UCase(WkBk.Sheets(Jy).Name) = UCase(XlsFoglio) Then
NomeFoglio = XlsFoglio
Exit For
End If
Next Jy
If NomeFoglio = "" Then
MsgBox "Foglio inesistente: " & XlsFoglio
Exit Sub
End If
Set ShFoglio = WkBk.Sheets(NomeFoglio)
For Jy = 1 To UBound(TabXY) 'per ogni prodotto definito nella tabella Globale
ShFoglio.cells(Jy, 1) = TabXY(Jy) 'scrivo l'importo del movimento
Next Jy
'quindi estraggo il risultato del calcolo alla cella 1:9
dblRendimento = Format(ShFoglio.cells(1, 9), "#0.00")
'per salvare le modifiche effettuate sul foglio (se in Italiano, altrimenti ="Y"
MyXL.Parent.Windows(1).Visible = True
SendKeys "S"
WkBk.Close
Set WkBk = Nothing
Set MyXL = Nothing
Set ShFoglio = Nothing
Me.WindowState = vbNormal
Exit Sub
CalcolaRendERR:
If Err = 3012 Then Resume Next 'Object 'name' already exists.
Me.WindowState = vbNormal
MsgBox Err & ": " & Err.Description
End Sub
Buon lavoro