VBA, Vba only runs once??

GreenSush
#1 / 3

Vba only runs once??

I have a control on an excel document that creates a word
document. Does anyone know why I can only run this code
once? If I want it to run again I have to close the excel
document and then open it back up again. Is there a
solution to this problem? I think when I hit the control
the second time the word document will be created in
memory but it wont display then I have document2 stuck in
memory. Please help.

Sun, 23 Oct 2005 00:30:35 GMT

Perr
#2 / 3

Vba only runs once??

Show relevant part of the code y're using.
Someone will be bound to give you an answer on this one

Krgrds,
Perry

Quote:

> I have a control on an excel document that creates a word
> document. Does anyone know why I can only run this code
> once? If I want it to run again I have to close the excel
> document and then open it back up again. Is there a
> solution to this problem? I think when I hit the control
> the second time the word document will be created in
> memory but it wont display then I have document2 stuck in
> memory. Please help.

Sun, 23 Oct 2005 06:24:16 GMT

GreenSush
#3 / 3

Vba only runs once??

Well here is the code that only runs once. I have to save
the excel document and reopen it everytime I want to run
the code here. This is driving me crazy.

Thank you
Ray

Public Sub createWordDoc()

'*******************************************
'Create needed variables
'*******************************************

Dim Pct As Integer
Dim i As Integer
Dim k As Integer
Dim y As Boolean
Dim strCurrentFieldName As String
Dim strCurrentCheckBoxName As String
Dim appWD As Word.Application
Dim myDocument As Word.Document

'*****************************************************
'Status Bar
'*****************************************************
Pct = 0
Application.StatusBar = "Processing Education Plan... " &
Pct & "% Completed"
Pct = Pct + 1

'*******************************************
'Create word document
'*******************************************
On Error GoTo ErrHdl
Set appWD = CreateObject("Word.Application")
Set myDocument = appWD.Documents.Add
'Set myRange = myDocument.Words(1)

'*******************************************
'Initialize all global variables
'*******************************************

Call setFieldVariables
Call setLocationName
Call setControlRange
Call setTableName

'******************************************************
'Set the layout of the word document to be landscape
'******************************************************

With appWD.ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With appWD.ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(11)
.PageHeight = InchesToPoints(8.5)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
appWD.ActiveWindow.ActivePane.View.Type = wdNormalView
appWD.Visible = True

'*********************************************************
****************************
'Create Header for the document
'*********************************************************
****************************

appWD.Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
appWD.Selection.Font.Size = 12
appWD.Selection.Font.Name = "Arial"
appWD.Selection.Font.Bold = wdToggle
appWD.Selection.TypeText Text:=Format(Date, "Long
Date")
appWD.Selection.TypeParagraph
appWD.Selection.TypeText Text:="INDIVIDUAL EDUCATION
PLAN FOR"
appWD.Selection.TypeParagraph
If Sheet1.Range("D2").Value <> "" Then
appWD.Selection.TypeText Text:=Sheet1.Range
("D2").Value
Else
appWD.Selection.Font.Color = wdColorRed
appWD.Selection.TypeText Text:="""STUDENT'S NAME"""
End If
appWD.Selection.Font.Color = wdColorBlack
appWD.Selection.TypeParagraph
appWD.Selection.TypeParagraph
appWD.Selection.Font.Bold = wdToggle
If appWD.Selection.Font.Underline = wdUnderlineNone
Then
appWD.Selection.Font.Underline = wdUnderlineSingle
Else
appWD.Selection.Font.Underline = wdUnderlineNone
End If
appWD.Selection.TypeText Text:="INSTRUCTIONAL
OBJECTIVES"
appWD.Selection.TypeParagraph
If appWD.Selection.Font.Underline = wdUnderlineNone
Then
appWD.Selection.Font.Underline = wdUnderlineSingle
Else
appWD.Selection.Font.Underline = wdUnderlineNone
End If
appWD.Selection.ParagraphFormat.Alignment =
wdAlignParagraphLeft
appWD.Selection.Font.Size = 12
appWD.Selection.Font.Name = "Times New Roman"

'********************************************************
****************************
'Loop throught the controls to see what is checked, then
put the coresponding values
'in the newly created word document and format the tables
'********************************************************
****************************

On Error GoTo ErrHdl
For i = 0 To 24
Application.StatusBar = "Processing Education
Plan... " & Pct & "% Completed"
Pct = Pct + 4
appWD.ScreenRefresh
y = False
strCurrentFieldName = "chk" & strLocationName(i)

For k = 1 To intControlRange(i)
strCurrentCheckBoxName = strCurrentFieldName
& CStr(k)

If ActiveSheet.OLEObjects
(strCurrentCheckBoxName).Object.Value = True Then

If y = False Then

appWD.Selection.MoveDown
Unit:=wdLine, Count:=1
appWD.Selection.TypeParagraph
appWD.Selection.TypeParagraph
appWD.Selection.Font.Size = 12
appWD.Selection.TypeText
Text:=strTableName(i)
appWD.Selection.TypeParagraph
appWD.Selection.Font.Size = 11
appWD.Selection.TypeParagraph
appWD.ActiveDocument.Tables.Add
Range:=appWD.Selection.Range, NumRows:=2, NumColumns:= _
4,
DefaultTableBehavior:=wdWord9TableBehavior,
AutoFitBehavior:= _
wdAutoFitFixed
With appWD.Selection.Tables(1)
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
appWD.Selection.Font.Bold =
wdToggle
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=4, Extend:=wdExtend

appWD.Selection.ParagraphFormat.Alignment =
wdAlignParagraphCenter
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=1
appWD.Selection.TypeText
Text:="GOAL"
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=4, Extend:=wdExtend

appWD.Selection.Range.HighlightColorIndex = wdBlack
appWD.Selection.Font.Color =
wdColorWhite
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=2
appWD.Selection.Font.Bold =
wdToggle
appWD.Selection.TypeText
Text:="OBJECTIVE"
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=9, Extend:=wdExtend

appWD.Selection.Range.HighlightColorIndex = wdBlack
appWD.Selection.Font.Color =
wdColorWhite
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=2
appWD.Selection.Font.Bold =
wdToggle
appWD.Selection.TypeText
Text:="CRITERIA"
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=9, Extend:=wdExtend
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=1, Extend:=wdExtend
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=1, Extend:=wdExtend

appWD.Selection.Range.HighlightColorIndex = wdBlack
appWD.Selection.Font.Color =
wdColorWhite
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=2
appWD.Selection.Font.Bold =
wdToggle
appWD.Selection.TypeText
Text:="NOTES"
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=6, Extend:=wdExtend
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=1, Extend:=wdExtend
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=1, Extend:=wdExtend

appWD.Selection.Range.HighlightColorIndex = wdBlack
appWD.Selection.Font.Color =
wdColorWhite
appWD.Selection.MoveDown
Unit:=wdLine, Count:=1
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=3
appWD.Selection.Font.Color =
wdColorBlack
appWD.Selection.TypeText
Text:=strFields(i, k - 1, 0)
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=1
appWD.Selection.TypeText
Text:=strFields(i, k - 1, 1)
appWD.Selection.MoveRight
Unit:=wdCharacter, Count:=1
appWD.Selection.TypeText
Text:=strFields(i, k - 1, 2)
appWD.Selection.MoveLeft
Unit:=wdCharacter, Count:=1

y = True

Else
appWD.Selection.MoveDown
Unit:=wdLine, Count:=1

appWD.ActiveDocument.Tables.Add
Range:=appWD.Selection.Range, NumRows:=1, NumColumns:= _
4,
DefaultTableBehavior:=wdWord9TableBehavior,
AutoFitBehavior:= _
wdAutoFitFixed
With appWD.Selection.Tables(1)
If .Style <> "Table Grid"
Then
...

read more »

Sun, 30 Oct 2005 03:18:21 GMT