peut on relancer une form en execution? - VB/VBA/VBS - Programmation
MarshPosté le 12-07-2004 à 22:04:04
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
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"
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
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
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
Marsh Posté le 12-07-2004 à 22:04:04
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