C
Christine
I'm using Word XP and the following code crashes word the first time I
open a new document with after I click the CommandButton1. Once it
crashes and I already have a word doc open and click on open new
document with template it works fine.
Private Sub UserForm_Initialize()
Dim sourcedoc As Document, i As Integer, j As Integer, myitem As
Range, m As Long, n As Long
'Modify the path in the following line so that it matches where
you Saved Suppliers.doc
Application.ScreenUpdating = False
'Open the file containing the client details
Set sourcedoc = Documents.Open(FileName:="S:\Files\Keywords.doc")
' Get the number or clients = number of rows in the table of
client details less one
i = sourcedoc.Tables(1).Rows.Count - 1
' Get the number of columns in the table of client details
j = sourcedoc.Tables(1).Columns.Count
' Set the number of columns in the Listbox to match
' the number of columns in the table of client details
ListBox1.ColumnCount = j
'Define an array to be loaded with the client data
Dim MyArray() As Variant
'Load client data into MyArray
ReDim MyArray(i, j)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = sourcedoc.Tables(1).Cell(m + 2, n + 1).Range
myitem.End = myitem.End - 1
MyArray(m, n) = myitem.Text
Next m
Next n
' Load data into ListBox1
ListBox1.List() = MyArray
' Close the file containing the client details
sourcedoc.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Private Sub ComboBox1_DropButtonClick()
With ComboBox1
If .ListCount = 0 Then
.AddItem "Usability"
.AddItem "Install"
.AddItem "Crash"
.AddItem "Hang"
.AddItem "Doc"
.AddItem "Performance"
.AddItem "Feature Failure"
.AddItem "New Feature"
.AddItem "Aesthetics"
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim Msg As String, i As Integer
Msg = ""
With Properties.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
Msg = Msg & .List(i) & Chr(13)
End If
Next i
End With
ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle).Value =
Titlebox.Text
ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor).Value =
Creatorbox.Text
ActiveDocument.CustomDocumentProperties("Document Number").Value =
Documentbox.Text
ActiveDocument.BuiltInDocumentProperties(wdPropertyCategory).Value
= ComboBox1.Value
ActiveDocument.BuiltInDocumentProperties(wdPropertyKeywords).Value
= Msg
ActiveDocument.BuiltInDocumentProperties(wdPropertyComments).Value
= Commentsbox.Text
With ActiveDocument
.Bookmarks("Title1").Range _
.InsertBefore Titlebox
End With
Properties.Hide
End Sub
The error signature is:
AppName: winword.exe AppVer: 10.0.2627.0 ModName: mso.dll
ModVer: 10.0.2625.0 Offset: 0006d6eb
open a new document with after I click the CommandButton1. Once it
crashes and I already have a word doc open and click on open new
document with template it works fine.
Private Sub UserForm_Initialize()
Dim sourcedoc As Document, i As Integer, j As Integer, myitem As
Range, m As Long, n As Long
'Modify the path in the following line so that it matches where
you Saved Suppliers.doc
Application.ScreenUpdating = False
'Open the file containing the client details
Set sourcedoc = Documents.Open(FileName:="S:\Files\Keywords.doc")
' Get the number or clients = number of rows in the table of
client details less one
i = sourcedoc.Tables(1).Rows.Count - 1
' Get the number of columns in the table of client details
j = sourcedoc.Tables(1).Columns.Count
' Set the number of columns in the Listbox to match
' the number of columns in the table of client details
ListBox1.ColumnCount = j
'Define an array to be loaded with the client data
Dim MyArray() As Variant
'Load client data into MyArray
ReDim MyArray(i, j)
For n = 0 To j - 1
For m = 0 To i - 1
Set myitem = sourcedoc.Tables(1).Cell(m + 2, n + 1).Range
myitem.End = myitem.End - 1
MyArray(m, n) = myitem.Text
Next m
Next n
' Load data into ListBox1
ListBox1.List() = MyArray
' Close the file containing the client details
sourcedoc.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Private Sub ComboBox1_DropButtonClick()
With ComboBox1
If .ListCount = 0 Then
.AddItem "Usability"
.AddItem "Install"
.AddItem "Crash"
.AddItem "Hang"
.AddItem "Doc"
.AddItem "Performance"
.AddItem "Feature Failure"
.AddItem "New Feature"
.AddItem "Aesthetics"
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim Msg As String, i As Integer
Msg = ""
With Properties.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
Msg = Msg & .List(i) & Chr(13)
End If
Next i
End With
ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle).Value =
Titlebox.Text
ActiveDocument.BuiltInDocumentProperties(wdPropertyAuthor).Value =
Creatorbox.Text
ActiveDocument.CustomDocumentProperties("Document Number").Value =
Documentbox.Text
ActiveDocument.BuiltInDocumentProperties(wdPropertyCategory).Value
= ComboBox1.Value
ActiveDocument.BuiltInDocumentProperties(wdPropertyKeywords).Value
= Msg
ActiveDocument.BuiltInDocumentProperties(wdPropertyComments).Value
= Commentsbox.Text
With ActiveDocument
.Bookmarks("Title1").Range _
.InsertBefore Titlebox
End With
Properties.Hide
End Sub
The error signature is:
AppName: winword.exe AppVer: 10.0.2627.0 ModName: mso.dll
ModVer: 10.0.2625.0 Offset: 0006d6eb