|
Word # creazione di un oggetto WORD
Set MyDoc = CreateObject("Word.application") ' inibisce la comparsa di word a video !! MyDoc.Visible = False ' MyDoc.Visible = True ' apertura documento For I = 1 To 15 Select Case I Case 1, 3, 5, 7, 9, 11, 13, 15 Form1.Rosso1.FillColor = &HC0C00FF 'priva Case 2, 4, 6, 8, 10, 12, 14 Form1.Rosso1.FillColor = &HC000 'priva End Select Rosso1.Refresh Pannello.Caption = "Attendere prego.. Apertura files " & Documenti(I) Pannello.Refresh MyDoc.Documents.Open filename:=Documenti(I) Next I MyDoc.Documents(Trim(Sorgente) & "\scheda15.doc").Activate ' CREA UN FILE NUOVO E CI SCRIVE QUALCOSA ' MyDoc.Documents.Add ' MyDoc.Selection.TypeParagraph ' MyDoc.Selection.TypeParagraph ' MyDoc.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter ' MyDoc.Selection.TypeText Text:="INIZIO DELLE ATTIVITA' DI CARICAMENTO" ' MyDoc.Selection.TypeParagraph ' LO SALVA COL NOME "PIPPO" ' Mydoc.ActiveDocument.SaveAs filename:= _ ' "C:\Programmi\Microsoft Office\Modelli\PIPPO.dot", FileFormat:= _ ' wdFormatTemplate, Password:="", AddToRecentFiles:= _ ' True, WritePassword:="" ' ' CHIUDE IL DOCUMENTO APERTO ' 'ActiveDocument.Close ' Salvataggio dati per moduli in formato testo 'For I = 1 To 15 ' With Options ' .AllowFastSave = True ' .BackgroundSave = True ' .CreateBackup = False ' .SavePropertiesPrompt = False ' .SaveInterval = 10 ' .SaveNormalPrompt = False ' End With ' With MyDoc.ActiveDocument ' .ReadOnlyRecommended = False ' .EmbedTrueTypeFonts = False ' .SaveFormsData = True ' .SaveSubsetFonts = False ' .Password = "" ' .WritePassword = "" '' End With ' Application.DefaultSaveFormat = "8Text" '' ' ' setta la directory di destinazione ' ChangeFileOpenDirectory Dir2.Path ' ' salva in formato : "solo dati per MODULI" ' MyDoc.ActiveDocument.SaveAs filename:=SalvaDocumenti(I), FileFormat:=wdFormatText, _ ' LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ ' :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ ' SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ ' False 'Pannello.Caption = "Attendere prego.. Salva il file " & SalvaDocumenti(I) 'Pannello.Refresh ' ' MyDoc.ActiveWindow.Close 'Pannello.Caption = "Attendere prego.. Chiusura del File " & SalvaDocumenti(I) 'Pannello.Refresh ' ' MyDoc.Windows(1).Activate ' 'Next '---------------------------------------------- Pannello.Caption = "Attendere prego..Elaborazione in corso" Pannello.Refresh Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" ChangeFileOpenDirectory "C:\APPOGGIO\" MyDoc.ActiveDocument.SaveAs filename:="scheda15.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda01.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda02.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda03.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda04.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda05.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda06.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &HC0C00FF 'priva Rosso1.Refresh With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda07.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda08.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda09.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda10.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda11.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close MyDoc.Windows(1).Activate Form1.Rosso1.FillColor = &H80FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda12.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda14.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close Form1.Rosso1.FillColor = &HC0C00FF 'priva With Options .AllowFastSave = True .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False End With With MyDoc.ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = True .SaveSubsetFonts = False .Password = "" .WritePassword = "" End With Application.DefaultSaveFormat = "8Text" MyDoc.ActiveDocument.SaveAs filename:="scheda13.txt", FileFormat:=wdFormatText, _ LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _ :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=True, SaveAsAOCELetter:= _ False MyDoc.ActiveWindow.Close '---------------------------------------------- ' Semaforo Verde Form1.Verde1.FillColor = &HFF00& Form1.Rosso1.FillColor = &H80& Form1.Rosso1.Refresh Form1.Verde1.Refresh File2.Refresh Pannello.Caption = "" Pannello.Refresh MyDoc.Application.Quit ' richiamo della funzione per l'inserimento dei files creati nella tabella Command5_Click Errore: If Err.Number = 4198 Then MsgBox "Il documento non e' stato chiuso" 'close Word application If Err.Number > 0 And Err.Number <> 50 Then MyDoc.Application.Quit End If |