Ciao a tt. Visto che è la "prima volta", spero di non fare casini...
Problema: sto sviluppando un applicativo in VBaccess ed ho necessità di creare una "Riunione" con Outlook (MSoffice ver. 2003); nel corpo testo della riunione ci debbo mettere testo ed un range excel MANTENENDO LA FORMATTAZIONE originaria (colori, bordi, celle, ecc). Le ho provate tutte (quelle che so, e non sono un gran ché...) tramite ObjectData ma il metodo è in grado di copiare solo testo e non riesco a duplicare in VBA quello che avviene se lo faccio a mano.
Posto il codice che uso in Access e col quale faccio una chiamata a codice Outlook che mi permette la gestione senza i noti warnings dell'applicazione.
Grazie in anticipo per l'aiuto.
Maurizio.
...........
FaccioTabellaFormattata
wTesto = wParte1 & wParte2 & wParte3
On Error GoTo ErrOtl
Set ObjOutlook = GetObject(, "Outlook.Application")
If ObjOutlook.CreaRiunione(Rst!Oggetto, _
Rst!Luogo, _
wInizio, _
wDurata, _
wParte1, _
wParte2, _
wParte3, _
wDestOK) Then
Convoco = True
Else
Convoco = False
End If
......
Private Sub FaccioTabellaFormattata()
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks.Add
Col = 1: Row = 1
ObjExcel.Sheets(1).Activate
With ObjExcel
.ActiveSheet.Cells(Row, Col).Value = "Rifer."
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Invitati"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Progetto"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Dalle"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Alle"
MaxCol = Col
Col = 1
For i = 1 To UBound(Arif)
Row = Row + 1
.ActiveSheet.Cells(Row, Col).Value = Arif(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Replace(Adestin(i), "+", "; ")
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = aProg(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Adalle(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Aalle(i)
Col = 1
Next i
MaxRow = Row
.ActiveSheet.Range(.Cells(1, 1), .Cells(MaxRow, MaxCol)).Select
.Cells.Select
.Cells.EntireColumn.AutoFit
Set ObjData = New DataObject
.Selection.Copy
ObjData.GetFromClipboard
wParte2 = ObjData.GetText
.ActiveWorkbook.Close SaveChanges:=False
End With
ObjExcel.Quit
Set ObjExcel = Nothing
End Sub
Problema: sto sviluppando un applicativo in VBaccess ed ho necessità di creare una "Riunione" con Outlook (MSoffice ver. 2003); nel corpo testo della riunione ci debbo mettere testo ed un range excel MANTENENDO LA FORMATTAZIONE originaria (colori, bordi, celle, ecc). Le ho provate tutte (quelle che so, e non sono un gran ché...) tramite ObjectData ma il metodo è in grado di copiare solo testo e non riesco a duplicare in VBA quello che avviene se lo faccio a mano.
Posto il codice che uso in Access e col quale faccio una chiamata a codice Outlook che mi permette la gestione senza i noti warnings dell'applicazione.
Grazie in anticipo per l'aiuto.
Maurizio.
...........
FaccioTabellaFormattata
wTesto = wParte1 & wParte2 & wParte3
On Error GoTo ErrOtl
Set ObjOutlook = GetObject(, "Outlook.Application")
If ObjOutlook.CreaRiunione(Rst!Oggetto, _
Rst!Luogo, _
wInizio, _
wDurata, _
wParte1, _
wParte2, _
wParte3, _
wDestOK) Then
Convoco = True
Else
Convoco = False
End If
......
Private Sub FaccioTabellaFormattata()
Set ObjExcel = CreateObject("Excel.Application")
ObjExcel.Visible = True
ObjExcel.Workbooks.Add
Col = 1: Row = 1
ObjExcel.Sheets(1).Activate
With ObjExcel
.ActiveSheet.Cells(Row, Col).Value = "Rifer."
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Invitati"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Progetto"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Dalle"
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = "Alle"
MaxCol = Col
Col = 1
For i = 1 To UBound(Arif)
Row = Row + 1
.ActiveSheet.Cells(Row, Col).Value = Arif(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Replace(Adestin(i), "+", "; ")
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = aProg(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Adalle(i)
Col = Col + 1
.ActiveSheet.Cells(Row, Col).Value = Aalle(i)
Col = 1
Next i
MaxRow = Row
.ActiveSheet.Range(.Cells(1, 1), .Cells(MaxRow, MaxCol)).Select
.Cells.Select
.Cells.EntireColumn.AutoFit
Set ObjData = New DataObject
.Selection.Copy
ObjData.GetFromClipboard
wParte2 = ObjData.GetText
.ActiveWorkbook.Close SaveChanges:=False
End With
ObjExcel.Quit
Set ObjExcel = Nothing
End Sub