Bonjour,
Désolé pour le délai de ma réponse ...
Le code utilisé est le suivant ( c'est un code que j'avais trouvé dans ce forum et que j'ai utilisé de nombreuses fois auparavant ... )
Il implique d'avoir un fichier Excel en entrée dont toutes les colonnes doivent avoir en entête le nom du champ technique Lotus
pour laquelle se rapporte les données à importer.
- Code : Tout sélectionner
Option Public
Option Explicit
Dim Session As NotesSession
Dim Db As NotesDatabase
Sub Initialize
On Error Goto err_ImportExcel
' Variable de sélection de fichier
Dim tmpFic As Variant
Dim sFic As String
' Variable de traitement de fichier Excel
Dim xlsApp As Variant ' Application Excel
Dim xlsWorkBook As Variant ' Classeur
Dim xlsSheet As Variant ' Feuille de calcul
Dim xlsLigne As Integer ' Ligne
Dim xlsColonne As Integer ' Colonne
' Demande de sélection du fichier Excel à traiter
tmpFic = OuvreXLS()
sFic = tmpFic(0)
' Tableau de données
Dim sLig() As String ' Met dans un tableau les données de la ligne
Dim sCol() As String ' Met dans un tableau les entêtes de colonne
' Compteur de boucle
Dim iCompteur As Integer
Dim iCompteurLigne As Integer
Dim iCompteurColonne As Integer
' Traitement sur le fichier Excel
Print "Connexion à Excel..."
Set xlsApp = CreateObject("Excel.Application") ' Création de l'instance
Print "Ouverture du fichier : " & sFic
xlsApp.Workbooks.Open sFic ' Ouverture du fichier
Set xlsWorkBook = xlsApp.ActiveWorkbook ' Récupère le classeur actuel
Set xlsSheet = xlsWorkBook.ActiveSheet ' Récupère la feuille active
xlsApp.Visible = False ' Affiche Excel
xlsSheet.Cells.SpecialCells(11).Activate
xlsLigne = xlsApp.ActiveWindow.ActiveCell.Row ' Nombre de lignes à traiter
Print "Nombre de lignes à traiter = "xlsLigne
xlsColonne = xlsApp.ActiveWindow.ActiveCell.Column ' Nombre de colonnes à traiter
Print "Nombre de colonnes à traiter = "xlsColonne
' Récupère les entêtes de colonne
xlsSheet.Cells(1, 1).Select
For iCompteurColonne = 1 To xlsColonne
If iCompteurColonne = 1 Then
Redim sCol(iCompteurColonne) As String
sCol(iCompteurColonne) = xlsSheet.Cells(1, iCompteurColonne).Value
Else
Redim Preserve sCol(iCompteurColonne) As String
sCol(iCompteurColonne) = xlsSheet.Cells(1, iCompteurColonne).Value
End If
Next
' Récupère les valeurs des cellules d'une ligne
For iCompteurLigne = 2 To xlsLigne
xlsSheet.Cells(iCompteurLigne, 1).select
For iCompteurColonne = 1 To xlsColonne
If iCompteurColonne = 1 Then
Redim sLig(iCompteurColonne) As String
sLig(iCompteurColonne) = xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
'Print "Valeur : " xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
Else
Redim Preserve sLig(iCompteurColonne) As String
sLig(iCompteurColonne) = xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
'Print "Valeur : " xlsSheet.Cells(iCompteurLigne, iCompteurColonne).Value
'Else
End If
Next
' Vérifie que le tableau n'est pas vide.
vVF = False
For iCompteur = 1 To Ubound(sLig)
If sLig(iCompteur) <> "" Then
vVF = True
Exit For
Else
vVF = False
End If
Next
Print "Traitement de la ligne " & iCompteurLigne & " sur " & xlsLigne
If vVF = True Then
Call CreationDocument(sLig, xlsColonne, sCol())
End If
Next
Print "Déconnexion d'Excel..."
xlsWorkBook.Close False ' Ferme le classeur
xlsApp.Quit ' Quitte Excel
Set xlsApp = Nothing ' Ferme l'instance
Print "Fin de l'importation du fichier Excel"
Exit Sub
err_ImportExcel:
Resume Next
End Sub
Sub Terminate
Print " Refresh de la vue après import"
Dim workspace As New NotesUIWorkspace
Call workspace.ViewRefresh
Print " Fin du refresh après import"
Print "< Fin procédure Import fichier >"
Print "-------------------------------------------------"
End Sub
Sub CreationDocument(aLigneATraiter() As String, NbColonne As Integer, sCol() As String)
Dim Session As NotesSession
Dim Db As NotesDatabase
Dim doc As NotesDocument
Dim iCompteur As Integer
On Error Goto err_CreationDocument
Set Session = New NotesSession
Set Db = Session.CurrentDatabase
Set doc = Db.CreateDocument
' Nom du masque à utiliser A MODIFIER SELON LE MASQUE
doc.Form = "sfTestCase"
For iCompteur = 1 To NbColonne
' Insère les valeurs dans les champs MonChampsX
Call doc.ReplaceItemValue(sCol(iCompteur), aLigneATraiter(iCompteur))
'Print " valeur avant sauvegarde : " aLigneATraiter(iCompteur)
Next
' Sauvegarde le masque
Dim Success As String
Success=doc.ComputeWithForm( True, False )
If Success Then
doc.Save True, True
'Print " Sauvegarde ... "
End If
Exit Sub
err_CreationDocument:
Exit Sub
End Sub
Function OuvreXLS() As Variant
Dim ws As New NotesUIWorkspace
' Affiche la fenêtre de sélection
' Le False correspond à une sélection simple
OuvreXLS = ws.OpenFileDialog(False, "Ouverture d'un fichier Excel", "Fichiers Excel | *.xls", "C:\")
End Function
Merci !
Publié: 07 Sep 2012 à 18:16