Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 12-21-2011, 06:35 AM
tinfanide tinfanide is offline Let Office Object Library 14.0 work in Office 2007 Windows 7 64bit Let Office Object Library 14.0 work in Office 2007 Office 2010 32bit
Expert
Let Office Object Library 14.0 work in Office 2007
 
Join Date: Aug 2011
Posts: 312
tinfanide is on a distinguished road
Default Let Office Object Library 14.0 work in Office 2007

Code:
Sub YahooDictWebQuery()
On Error Resume Next
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
Dim IE As New InternetExplorer
IE.Visible = True
IE.navigate "http://hk.dictionary.yahoo.com/dictionary?p=" & Cells(x, 1).Value
Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE
Dim Doc As HTMLDocument
Set Doc = IE.document
    Cells(x, 3).Value = WorksheetFunction.Substitute(WorksheetFunction.Substitute(WorksheetFunction.Substitute(Right(Doc.getElementsByClassName("pronunciation")(0).getElementsByTagName("div")(0).innerText, WorksheetFunction.Search("DJ", Doc.getElementsByClassName("pronunciation")(0).getElementsByTagName("div")(0).innerText) - 1), "DJ", ""), "[", ""), "]", "")
    Cells(x, 4).Value = Left(Doc.getElementsByClassName("caption")(0).innerText, WorksheetFunction.Search(".", Doc.getElementsByClassName("caption")(0).innerText))
    Cells(x, 5).Value = WorksheetFunction.Substitute(Doc.getElementsByClassName("description")(0).innerText, "1. ", "")
Next x
IE.Quit
On Error GoTo 0
End Sub
Code:
Sub CopyVocabListToWord()


On Error Resume Next

Dim formLevel As String
formLevel = InputBox("The Form the Vocabulary List is being made for:" & vbNewLine & _
"e.g. For Form 3, type '3'", "Class Level")

Dim VocabListTitle As String
VocabListTitle = InputBox("Enter the title of this Vocabulary List:" & vbNewLine & _
"e.g. Unit n    Textbook Topic (p.P-P)" _
, "Document Title")

Dim VocabListName As String
ActiveSheet.Name = VocabListName

Dim wrdApp As Word.Application
Set wrdApp = CreateObject("Word.Application")

Dim wrdDoc As Word.document
Set wrdDoc = wrdApp.Documents.Add
wrdApp.Visible = True

Dim wrdTbl As Word.Table
Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, _
NumRows:=ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2, _
NumColumns:=4)


With wrdTbl

    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderRight).LineStyle = wdLineStyleSingle
    .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
    .Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
    
    For c = 1 To 2
    .Rows(c).Cells.Merge
    Next c
        
For r = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    .Cell(2 * r + 2, 2).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    .Cell(2 * r + 2, 4).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    
    .Range.Font.Name = "Times New Roman"
    .Range.ParagraphFormat.SpaceBefore = 6
    .Range.ParagraphFormat.SpaceAfter = 6
    
If Not r Mod 2 = 0 Then
    .Cell(r + 2, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
    .Cell(r + 2, 2).Range.Text = ActiveSheet.Cells(r, 5).Value
    .Cell(r + 1 + 2, 1).Range.Text = "/" & ActiveSheet.Cells(r, 3).Value & "/"
    .Cell(r + 1 + 2, 2).Range.Text = "(" & ActiveSheet.Cells(r, 2).Value & ")" & " " & "(" & ActiveSheet.Cells(r, 4).Value & ")"
    .Cell(r + 1 + 2, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
End If
If r Mod 2 = 0 Then
    .Cell(r - 1 + 2, 3).Range.Text = ActiveSheet.Cells(r, 1).Value
    .Cell(r - 1 + 2, 4).Range.Text = ActiveSheet.Cells(r, 5).Value
    .Cell(r + 2, 3).Range.Text = "/" & ActiveSheet.Cells(r, 3).Value & "/"
    .Cell(r + 2, 4).Range.Text = "(" & ActiveSheet.Cells(r, 2).Value & ")" & " " & "(" & ActiveSheet.Cells(r, 4).Value & ")"
    .Cell(r + 2, 4).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
End If
Next r


Dim wrdTpl As Word.ListTemplate
Set wrdTpl = wrdApp.ListGalleries(wdNumberGallery).ListTemplates(1)
With wrdTpl.ListLevels(1)
    .NumberFormat = "%1."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = wrdApp.CentimetersToPoints(0.1)
    .TextPosition = wrdApp.CentimetersToPoints(0.8)
    .Alignment = wdListLevelAlignLeft
    .TabPosition = wdUndefined
    .StartAt = 1
End With

Dim rng As Word.Range
Set rng = wrdTbl.Range
rng.ListFormat.ApplyListTemplate ListTemplate:=wrdTpl

.Rows(1).Range.ListFormat.RemoveNumbers
For r = 2 To 16 Step 2
    
    .Rows(r).Range.ListFormat.RemoveNumbers
    For c = 2 To 4 Step 2
    .Cell(r - 1, c).Range.ListFormat.RemoveNumbers
    Next c
Next r


For nTxtNum = 1 To 5
.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum - 1)) - 1).Range.Rows.Add
.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum)) - 1).Range.Rows.Add
.Rows(ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum - 1)).Cells.Merge
.Rows(ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 2) + (nTxtNum - 1)).Cells.Merge
.Rows(ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 2) + (nTxtNum - 1)).Range.Text = ActiveSheet.Cells(nTxtNum, 7).Value

.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum))).Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum))).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum))).Borders(wdBorderRight).LineStyle = wdLineStyleNone

.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum - 1))).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Rows((ActiveSheet.Cells(nTxtNum, 8) + (nTxtNum + 1) + (nTxtNum - 1))).Borders(wdBorderRight).LineStyle = wdLineStyleNone

Next nTxtNum

wrdDoc.Range(Start:=.Rows(1).Range.Start, End:=.Rows(2).Range.End).Borders(wdBorderTop).LineStyle = wdLineStyleNone
wrdDoc.Range(Start:=.Rows(1).Range.Start, End:=.Rows(2).Range.End).Borders(wdBorderLeft).LineStyle = wdLineStyleNone
wrdDoc.Range(Start:=.Rows(1).Range.Start, End:=.Rows(2).Range.End).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
wrdDoc.Range(Start:=.Rows(1).Range.Start, End:=.Rows(2).Range.End).Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Rows(1).Range.Borders(wdBorderBottom).LineStyle = wdLineStyleNone

.Rows(1).Range.Text = VocabListTitle
.Rows(2).Range.Text = "Vocabulary"
.Rows(3).Delete

End With

With wrdTbl.Rows(1).Range
    .InsertParagraphBefore
    .InsertBefore ("Class: " & formLevel & "__________                                                              Name: _________________(     )")
End With

With wrdDoc.Sections(1)
    .Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberCenter, FirstPage:=True
End With


MsgBox ("Now, you're going to save the document." & vbNewLine & _
"You may need to manually alter part of the document to suit your needs." & vbNewLine & _
"This VBA application only helps you batch produce a document.")

wrdDoc.Save
Set wrdDoc = Nothing
Set wrdApp = Nothing
On Error GoTo 0
End Sub
I've written two modules in the Office 2010 environment and they work well. But in Office 2007, it says "Office Object Library 12.0 missing". How can I fix it such that it can also run in Office 2007?
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Let Office Object Library 14.0 work in Office 2007 Excel VBA: How to add a reference to Microsoft Word Object Library? tinfanide Excel Programming 7 12-12-2011 05:21 AM
Problem: object library invalid or contains references to object definitions aligahk06 Office 0 08-19-2010 12:29 PM
Using Office Premium 2007 Trial with Already Installed Office Home and Student 2007 SME Office 1 10-07-2009 06:51 AM
Let Office Object Library 14.0 work in Office 2007 Office 2007 Professional shipped from US, will it work on UK Windows PC's ? OfficeDude Office 3 08-16-2009 02:11 PM
Access Object library 10 Gyto Office 0 10-09-2008 09:04 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 11:22 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft