22. marts 2004 - 10:56Der er
9 kommentarer og 1 løsning
Luk Word (Hårdt, og uden nogensomhelst spørgsmål)
Jeg vil lukke word ned hårdt og brutalt, men kan ikke finde ud af hvordan. Grunden til at jeg vil gøre det på denne måde er at jeg åbner et word dok, hvor der startes en makro (en form) når dokumentet lukkes, og jeg ønsker ikke at der skal trykkes på nogle knapper. Jeg skal bare se i dokumentet ikke lave ændringer, dette er forøvrigt ikke noget problem. Og nej Word.ActivDocument.Close savechanges:= wdDoNotSaveChanges virker ikke, den starter makroen alligevel, i øvrigt startes formen uanset hvad man stiller sikkerhedsniveauet til. Håber nogen kan hjælpe.
Prøv at se på det her kode ? Noget jeg lige rendte over:
'Example is using reference of Microsoft Word 2000 dll library to automate and demonstrate the 'activites in the examples so if you find any trouble in running example then install microsoft word 2000. Dim WordApp As New Word.Application Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'create new word document Dim doc As New Word.Document 'add new word document to word aplication documents collection and 'set the reference of newly created document to "doc" variable doc = WordApp.Documents.Add() 'string to write Dim str As String str = "Text Formatting:" 'with the word app selection write the value in the document With WordApp.Selection 'set the word selection font size +2 to the selection font size .Font.Size = WordApp.Selection.Font.Size + 2 'making selection font to bold .Font.Bold = True 'inserting text in the document .TypeText(str) 'setting font size back to current-2 .Font.Size = WordApp.Selection.Font.Size - 2 'making the selected font back to false .Font.Bold = False 'start paragraph .TypeParagraph() 'change the pragraph text color to red .Font.Color = Word.WdColor.wdColorDarkRed 'set the selection font not to italic .Font.Italic = False 'inserting text to the document. that will apear in red .TypeText("This sentence will appear in red. ") 'start paragraph .TypeParagraph() 'change the paragraph text color to black .Font.Color = Word.WdColor.wdColorBlack 'set the selection font to italic .Font.Italic = True 'setting font size back to current+2 .Font.Size = WordApp.Selection.Font.Size + 2 'inserting text to the document. that will apear in black .TypeText("Text color was reset to black, " & _ "but the font size was increased by two points") End With 'filename Dim fName As String SaveFileDialog1.Filter = "Documents|*.doc" SaveFileDialog1.ShowDialog() fName = SaveFileDialog1.FileName 'if fname is nothing then show document's save as dialog If fName <> "" Then Try doc.SaveAs(fName) Catch exc As Exception MsgBox("Failed to save document" & _ vbCrLf & exc.Message) End Try End If 'counting of paragraphs word and characters MsgBox("The document contains " & doc.Paragraphs.Count & " paragraphs " & vbCrLf & _ doc.Words.Count & " words and " & doc.Characters.Count & " words") 'closing document doc.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
Tak til Alle for forsøgene, jeg har fundet følgende her på eksperten, og det er det jeg skal bruge så jeg lukker nu: Option Explicit Const MAX_PATH& = 260
Declare Function TerminateProcess _ Lib "kernel32" (ByVal ApphProcess As Long, _ ByVal uExitCode As Long) As Long Declare Function OpenProcess Lib _ "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal blnheritHandle As Long, _ ByVal dwAppProcessId As Long) As Long Declare Function ProcessFirst _ Lib "kernel32" Alias "Process32First" _ (ByVal hSnapshot As Long, _ uProcess As PROCESSENTRY32) As Long Declare Function ProcessNext _ Lib "kernel32" Alias "Process32Next" _ (ByVal hSnapshot As Long, _ uProcess As PROCESSENTRY32) As Long Declare Function CreateToolhelpSnapshot _ Lib "kernel32" Alias "CreateToolhelp32Snapshot" _ (ByVal lFlags As Long, _ lProcessID As Long) As Long Declare Function CloseHandle _ Lib "kernel32" (ByVal hObject As Long) As Long
Private Type LUID lowpart As Long highpart As Long End Type
Private Type TOKEN_PRIVILEGES PrivilegeCount As Long LuidUDT As LUID Attributes As Long End Type
Private Declare Function GetVersion _ Lib "kernel32" () As Long Private Declare Function GetCurrentProcess _ Lib "kernel32" () As Long Private Declare Function OpenProcessToken _ Lib "advapi32" (ByVal ProcessHandle As Long, _ ByVal DesiredAccess As Long, _ TokenHandle As Long) As Long Private Declare Function LookupPrivilegeValue _ Lib "advapi32" Alias "LookupPrivilegeValueA" _ (ByVal lpSystemName As String, _ ByVal lpName As String, _ lpLuid As LUID) As Long Private Declare Function AdjustTokenPrivileges _ Lib "advapi32" (ByVal TokenHandle As Long, _ ByVal DisableAllPrivileges As Long, _ NewState As TOKEN_PRIVILEGES, _ ByVal BufferLength As Long, _ PreviousState As Any, _ ReturnLength As Any) As Long
Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szexeFile As String * MAX_PATH End Type '--------------------------------------- Public Function KillApp(myName As String) As Boolean Const TH32CS_SNAPPROCESS As Long = 2& Const PROCESS_ALL_ACCESS = 0 Dim uProcess As PROCESSENTRY32 Dim rProcessFound As Long Dim hSnapshot As Long Dim szExename As String Dim exitCode As Long Dim myProcess As Long Dim AppKill As Boolean Dim appCount As Integer Dim i As Integer On Local Error GoTo Finish appCount = 0
uProcess.dwSize = Len(uProcess) hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&) rProcessFound = ProcessFirst(hSnapshot, uProcess) Do While rProcessFound i = InStr(1, uProcess.szexeFile, Chr(0)) szExename = LCase$(Left$(uProcess.szexeFile, i - 1)) If Right$(szExename, Len(myName)) = LCase$(myName) Then KillApp = True appCount = appCount + 1 myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID) If KillProcess(uProcess.th32ProcessID, 0) Then 'For debug.... Remove this ' MsgBox "Instance no. " & appCount & " of " & szExename & " was terminated!" End If
End If rProcessFound = ProcessNext(hSnapshot, uProcess) Loop Call CloseHandle(hSnapshot) Exit Function Finish: MsgBox "Error!" End Function
'Terminate any application and return an exit code to Windows. Function KillProcess(ByVal hProcessID As Long, Optional ByVal exitCode As Long) As Boolean Dim hToken As Long Dim hProcess As Long Dim tp As TOKEN_PRIVILEGES
If GetVersion() >= 0 Then
If OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken) = 0 Then GoTo CleanUp End If
If LookupPrivilegeValue("", "SeDebugPrivilege", tp.LuidUDT) = 0 Then GoTo CleanUp End If
If AdjustTokenPrivileges(hToken, False, tp, 0, ByVal 0&, ByVal 0&) = 0 Then GoTo CleanUp End If End If
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hProcessID) If hProcess Then
KillProcess = (TerminateProcess(hProcess, exitCode) <> 0) ' close the process handle CloseHandle hProcess End If
If GetVersion() >= 0 Then ' under NT restore original privileges tp.Attributes = 0 AdjustTokenPrivileges hToken, False, tp, 0, ByVal 0&, ByVal 0&
CleanUp: If hToken Then CloseHandle hToken End If
End Function ' End Module code
'Example on how to use the code' this is the click event of a button named cmdKill Private Sub cmdKill() ' Usage: Dim pID As Long Dim i As Integer Dim strExe As String 'C:\Programmer\Microsoft Office\Office10\ strExe = "winword.exe" For i = 0 To 4 pID = Shell(strExe, vbNormalFocus) Next i 'KillProcess pID, 0 ' KillApp ("winword.exe") 'Five instances of notpade.exe is now created 'Debug.Assert False 'KillApp (strExe) MsgBox "It is " & _ KillApp(strExe) & _ " that all instances of " & vbCrLf & _ strExe & _ " have been terminated!"
End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.