salut a tou(te)s
dans mon programme:
ouverture d'un classeur Excel
recherche une cellule dans ce classeur Excel
copie son contenu vers un document Word (tableau)
quitte en enregistrant OU fait une nouvelle recherche
j'ai un probleme au niveau de la nouvelle recherche:
voici mon code : (explication apres)
Dim appExcel As Object
Dim classeur As Excel.Workbook
Dim feuille As Excel.Worksheet
Dim appWord As Object
Dim appWord2 As Object
Dim DocWord As New Word.Document
Dim docWord2 As New Word.Document
Dim i As Integer
Dim l As Integer
Dim c As Integer
Private Sub Dir_Change() 'changer de repertoire
File.Path = Dir.Path
File.Pattern = "*.xls"
End Sub
Private Sub Drive_Change() 'changer de lecteur
Dir.Path = Left$(Drive.Drive, 2) + "\"
File.Path = Dir.Path
File.Pattern = "*.xls"
End Sub
Private Sub Form_Load() 'lancement de la premiere form
Drive.Drive = "c:\"
Dir.Path = "c:\"
File.Path = "c:\"
File.Pattern = "*.xls"
End Sub
Private Sub Imprimer_Click() 'imprime le document Word
If Not appWord Is Nothing Then
appWord.ActiveDocument.PrintOut
Else: MsgBox ("Veuillez d'abord générer le document" )
End If
End Sub
Private Sub new_Click() 'effectuer une nouvelle recherche
If Not appWord Is Nothing Or Not appWord2 Is Nothing Or Not appExcel Is Nothing Then
appWord.DisplayAlerts = False
appWord2.DisplayAlerts = False
appExcel.DisplayAlerts = False
appWord.ActiveDocument.SaveAs FileName:="c:\dernier_docWord.doc"
classeur.Close
appExcel.Quit
DocWord.Close
docWord2.Close False
appWord.Quit
appWord2.Quit
End If
'If File.FileName = "etiq ean 13 .xls" Then
'Set appExcel = CreateObject("Excel.Application" )
' Set classeur = appExcel.ActiveWorkbook
' appExcel.Visible = True
' Set classeur = appExcel.Workbooks.Open(Dir.Path + "\" + File.FileName)
'Else: MsgBox ("Veuillez selectionner le fichier: etiq ean 13 .xls" )
'End If
'appExcel.Activate
'classeur.Activate
'feuille.Activate
'Form1.Show
Dim formtruc As New Form1
End Sub
Public Sub Valider_Click() 'valide le fichier excel a ouvrir
If File.FileName = "etiq ean 13 .xls" Then
Set appExcel = CreateObject("Excel.Application" )
Set classeur = appExcel.ActiveWorkbook
appExcel.Visible = True
Set classeur = appExcel.Workbooks.Open(Dir.Path + "\" + File.FileName)
Else: MsgBox ("Veuillez selectionner le fichier: etiq ean 13 .xls" )
End If
Form1.Show
End Sub
Private Sub quit_bout_Click() 'quitte le programme
If Not appWord Is Nothing Or Not appWord2 Is Nothing Or Not appExcel Is Nothing Then
appWord.DisplayAlerts = False
appWord2.DisplayAlerts = False
appExcel.DisplayAlerts = False
appWord.ActiveDocument.SaveAs FileName:="c:\dernier_docWord.doc"
classeur.Close
appExcel.Quit
DocWord.Close
docWord2.Close False
appWord.Quit
appWord2.Quit
Set feuille = Nothing
Set classeur = Nothing
Set appExcel = Nothing
Set DocWord = Nothing
Set appWord = Nothing
Set docWord2 = Nothing
Set appWord2 = Nothing
End If
End
End Sub
Public Sub gendoc_Click() 'genere le doc cument Word
If Not appExcel Is Nothing Then
Set feuille = ActiveWorkbook.ActiveSheet 'probleme lors d'une nouvelle recherhce
If appExcel.ActiveSheet.Name = "Riello" Then
appExcel.Cells.Find(What:=ligne).Activate
appExcel.Cells.Find(What:=ligne).Select
l = Selection.Row
c = Selection.Column
appExcel.Cells(l, 6).Select
appExcel.Selection.Font.Size = 48
appExcel.Cells(l, 6).Copy
Set appWord2 = CreateObject("Word.Application" )
Set docWord2 = appWord2.Documents.Add
appWord2.ActiveDocument.Range.Font.Size = 4
appWord2.ActiveDocument.Range.Font.Name = "Arial"
appWord2.Visible = False
Set appWord = CreateObject("Word.Application" )
Set DocWord = appWord.Documents.Open("c:\etiquette.dot" )
appWord.Visible = True
docWord2.Activate
appWord2.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
appWord2.Selection.PasteSpecial
appExcel.Cells(l, 1).Select
appExcel.Selection.Font.Size = 14
appExcel.Cells(l, 1).Copy
appWord2.Selection.PasteSpecial
appExcel.Cells(l, 3).Select
appExcel.Selection.Font.Size = 14
appExcel.Cells(l, 3).Copy
appWord2.Selection.PasteSpecial
appWord2.Selection.HomeKey Unit:=Word.WdUnits.wdStory, Extend:=Word.WdMovementType.wdMove
appWord2.Selection.EndKey Unit:=Word.WdUnits.wdStory, Extend:=Word.WdMovementType.wdExtend
appWord2.Selection.Copy
DocWord.Activate
appWord.ActiveDocument.Tables.Item(1).Range.Font.Size = 4
appWord.ActiveDocument.Tables.Item(1).Range.Font.Name = "Arial"
For i = 1 To 7
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=1).Range.PasteSpecial
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=1).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=3).Range.PasteSpecial
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=3).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
Next
Else
appExcel.Cells.Find(What:=ligne).Activate
appExcel.Cells.Find(What:=ligne).Select
l = Selection.Row
c = Selection.Column
appExcel.Cells(l, 6).Select
appExcel.Selection.Font.Size = 48
appExcel.Cells(l, 6).Copy
Set appWord2 = CreateObject("Word.Application" )
Set docWord2 = appWord2.Documents.Add
appWord2.ActiveDocument.Range.Font.Size = 4
appWord2.ActiveDocument.Range.Font.Name = "Arial"
appWord2.Visible = False
Set appWord = CreateObject("Word.Application" )
Set DocWord = appWord.Documents.Open("c:\etiquette.dot" )
appWord.Visible = True
docWord2.Activate
appWord2.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
appWord2.Selection.PasteSpecial
appExcel.Cells(l, 3).Select
appExcel.Selection.Font.Size = 14
appExcel.Cells(l, 3).Copy
appWord2.Selection.PasteSpecial
appExcel.Cells(l, 4).Select
appExcel.Selection.Font.Size = 14
appExcel.Cells(l, 4).Copy
appWord2.Selection.PasteSpecial
appWord2.Selection.HomeKey Unit:=Word.WdUnits.wdStory, Extend:=Word.WdMovementType.wdMove
appWord2.Selection.EndKey Unit:=Word.WdUnits.wdStory, Extend:=Word.WdMovementType.wdExtend
appWord2.Selection.Copy
DocWord.Activate
appWord.ActiveDocument.Tables.Item(1).Range.Font.Size = 4
appWord.ActiveDocument.Tables.Item(1).Range.Font.Name = "Arial"
For i = 1 To 7
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=1).Range.PasteSpecial
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=1).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=3).Range.PasteSpecial
appWord.ActiveDocument.Tables.Item(1).Cell(Row:=i, Column:=3).Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
Next
End If
Else: MsgBox ("Veuillez d'abord selectionnez le fichier etiq ean 13 .xls" )
End If
Form1.Show
End Sub
donc a la nouvelle recherche la ligne "Set feuille = ActiveWorkbook.ActiveSheet" il plante
comment puis je faire pour pour qu'il reinstancie la feuille avec le nouveau Excel?
je ne suis pas tres clair ptet
si vous ne comprennez pas dite le moi j'essaierai d'etre plus clair
merci a vous tous
