View Single Post
 
Old 02-18-2014, 12:45 PM
CIF CIF is offline Windows 7 32bit Office 2007
Novice
 
Join Date: Feb 2014
Posts: 7
CIF is on a distinguished road
Default Applied code to one of my worksheets and now getting error message at red-type line.

Code:
 
Sub Soundsoak_CreateQuote1()
'Collect the Needed Information
Dim myProject, myCompanyInfoL1, myCompanyInfoL2, myCompanyInfoL3, myQuoteNumber As String
Dim mycustomer, mydate As String, myuser As String, myDate1 As String, myDate2 As String, myDate3 As String
Dim myquote1, myquote2, myquote3, myquote4, myquote5, myquote6, myquote7, myquote8 As String
Dim myFileName As String
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Application.ScreenUpdating = False
With ActiveWorkbook.Sheets("Project Setup")
myProject = .Range("B4").Text
myCompanyInfoL1 = .Range("B8").Text
myCompanyInfoL2 = .Range("B6").Text & " - " & .Range("B7").Text
myCompanyInfoL3 = .Range("B5").Text
myQuoteNumber = .Range("E5").Text
mycustomer = .Range("B6").Text
mydate = .Range("E6").Text
myuser = .Range("E8").Text
myDate1 = .Range("A29").Text
myDate2 = .Range("A30").Text
myDate3 = .Range("A31").Text
End With
With ActiveWorkbook.Sheets("Quote Opt 1")
myquote1 = .Range("F4").Text
myquote2 = .Range("F5").Text
myquote3 = .Range("F6").Text
myquote4 = .Range("F8").Text
myquote5 = .Range("F9").Text
myquote6 = .Range("F10").Text
myquote7 = .Range("F11").Text
myquote8 = .Range("F12").Text
End With
Set wrdDoc = wrdApp.Documents.Add(Template:="G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\SoundsoakQuote1.dotx")
Do While wrdDoc Is Nothing: Loop
With wrdDoc
    If .Bookmarks.Exists("Project") Then .Bookmarks("Project").Range.Text = myProject
    If .Bookmarks.Exists("ToL1") Then .Bookmarks("ToL1").Range.Text = myCompanyInfoL1
    If .Bookmarks.Exists("ToL2") Then .Bookmarks("ToL2").Range.Text = myCompanyInfoL2
    If .Bookmarks.Exists("ToL3") Then .Bookmarks("ToL3").Range.Text = myCompanyInfoL3
    If .Bookmarks.Exists("Header1") Then .Bookmarks("Header1").Range.Text = myCompanyInfoL2
    If .Bookmarks.Exists("Date") Then .Bookmarks("Date").Range.Text = mydate
    If .Bookmarks.Exists("User") Then .Bookmarks("User").Range.Text = myuser
    If .Bookmarks.Exists("QuoteNo") Then .Bookmarks("QuoteNo").Range.Text = myQuoteNumber
    If .Bookmarks.Exists("Esc") Then .Bookmarks("Esc").Range.Text = myDate1
    If .Bookmarks.Exists("Esc1") Then .Bookmarks("Esc1").Range.Text = myDate1
    If .Bookmarks.Exists("Esc2") Then .Bookmarks("Esc2").Range.Text = myDate2
    If .Bookmarks.Exists("Esc3") Then .Bookmarks("Esc3").Range.Text = myDate3
    If .Bookmarks.Exists("Project1") Then .Bookmarks("Project1").Range.Text = myProject
    If .Bookmarks.Exists("QuoteNo1") Then .Bookmarks("QuoteNo1").Range.Text = myQuoteNumber
    If .Bookmarks.Exists("Q1") Then .Bookmarks("Q1").Range.Text = myquote1
    If .Bookmarks.Exists("Q2") Then .Bookmarks("Q2").Range.Text = myquote2
    If .Bookmarks.Exists("Q3") Then .Bookmarks("Q3").Range.Text = myquote3
    If .Bookmarks.Exists("Q4") Then .Bookmarks("Q4").Range.Text = myquote4
    If .Bookmarks.Exists("Q5") Then .Bookmarks("Q5").Range.Text = myquote5
    If .Bookmarks.Exists("Q6") Then .Bookmarks("Q6").Range.Text = myquote6
    If .Bookmarks.Exists("Q7") Then .Bookmarks("Q7").Range.Text = myquote7
    If .Bookmarks.Exists("Q8") Then .Bookmarks("Q8").Range.Text = myquote8
    If .Bookmarks.Exists("Table") Then
        ThisWorkbook.Sheets("Quote Opt 1").Range("Table1", LastNonBlankCell(Sheets("Quote Opt 1"))).Copy
        .Bookmarks("Table").Range.Paste
    End If
 
    myFileName = myProject & " " & myQuoteNumber & "_" & mycustomer & " " & "Quote" & " "
 
   With .Dialogs(wdDialogFileSummaryInfo)
        .Title = myFileName
        .Execute
    End With
 
    .SaveAs ("G:\ABP\ArchSpec\Project Files\Quotes\2014\Soundsoak\" & myFileName & Format(Date, "mm-dd-yy") & ".docx")
    End With
    wrdApp.Visible = True
    Set wrdDoc = Nothing: Set wrdApp = Nothing
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Reply With Quote