peut on relancer une form en execution?

peut on relancer une form en execution? - VB/VBA/VBS - Programmation

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

Reply

Marsh Posté le 12-07-2004 à 22:04:04   

Reply

Marsh Posté le 13-07-2004 à 00:21:15    

plutôt que Set appExcel = Nothing essaie de masquer la feuille.  
 


---------------
What if I were smiling and running into your arms? Would you see then what I see now?  
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed