![]() |
|
#1
|
|||
|
|||
|
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
|
|
#2
|
||||
|
||||
|
Hi tinfanide,
That's a by-product of using early binding. You have two options: • delete the reference to the Word 14 from the vba editor and use late binding; or • re-compile the code on a system using Word 2007 or earlier - ideally, on the earliest possible version the code will need to run on.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
|||
|
|||
|
Quote:
How about late binding? In my codes: Code:
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
|
|
#4
|
|||
|
|||
|
Could anyone who has got Excel 2007 test it for me? I just couldn't figure out why it does not work in 07? Just reports "Loading DLL error".
|
|
#5
|
|||
|
|||
|
Code:
Sub test()
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
Dim wrdDoc As Object
Set wrdDoc = wrdApp.Documents.Add
wrdApp.Visible = True
Dim wrdTbl As Object
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
End With
Set wrdApp = Nothing
Set wrdDoc = Nothing
Set wrdTbl = Nothing
End Sub
In the above case, the table is created but borders not added. It reports, "Applicaton defined or object defined error". Code:
Dim wrdTbl = Word.Table Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, _ NumRows:=ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2, _ NumColumns:=4) |
|
#6
|
|||
|
|||
|
Make it clearer
Run this in Word Code:
Sub test()
Dim wrdTbl As Object
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
End With
End Sub
Code:
Sub test()
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
Dim wrdDoc As Object
Set wrdDoc = wrdApp.Documents.Add
wrdApp.Visible = True
Dim wrdTbl As Object
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
End With
End Sub
This one... Excel tells you "Runtime Error '5941; Application defined or object defined error'" Table created but borders not added |
|
#7
|
||||
|
||||
|
Hi tinfanide,
It's a bit more involved than simply unchecking the "Microsoft Word Object Library 14.0" reference. See: http://support.microsoft.com/default...b;EN-US;245115 Amongst other things, you'd change all the Word-specific definitions to 'Object': Dim wrdApp As Object, wrdDoc As Object, wrdTbl As Object, wrdTpl As Object and you'd change: Dim rng as Word.Range to: Dim rng as Range or, better still: Dim wdRng As Range You might also need to change some Word-specific parameters to the values. The code will throw an error on any affected lines. Simply replace those parameters' names with their numeric values.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#8
|
|||
|
|||
|
Quote:
Code:
Dim wrdTbl As Table Dim wrdRng As Range please see the comments below. When I need to not set reference to any object library so that users can use my macro any version of the Office applications (in my case, I write the macro in 2010, but want my users to run in 2007 and I don't want to start everything in Word Object Library 12.0) Code:
Sub setTableBorders()
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
Dim wrdDoc As Object
Set wrdDoc = wrdApp.documents.Add
wrdApp.Visible = True
' Dim wrdTbl As Table doesn't work in Excel VBA
Dim wrdTbl As Object
Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, _
NumRows:=4, _
NumColumns:=1)
With wrdTbl
For r = 1 To 4
.Cell(r, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
Next r
' Starting from this line, it does not work
' Application-defined or Object-defined error
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderRight).LineStyle = wdLineStyleSingle
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
.Borders(wdBorderVertical).LineStyle = wdLineStyleSingle
End With
End Sub
Book1.xlsm Please see the attachment. |
|
#9
|
||||
|
||||
|
Hi tinfanide,
As I said Quote:
As for "I don't want to start everything in Word Object Library 12.0", I think maybe you've misunderstood what that implies. If the 12 library isn't available with early binding, a later available library will be used - it just doesn't go the other way. With late binding, whatever library is available will be used (eg 9, if that's all that's available). As mentioned in my last post: Quote:
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle you need to look at both the 'WdBorderType Enumeration' and the 'WdLineStyle Enumeration' in the Word vba Help file, and subsitute the numeric values for the Word names. You'd probably find the conversion to late binding less painful if you were to create a new Word document with just the Word portion of your code in it as a test sub, then step through the code, identifying the numeric values that go with each of the Word-specific parameters in your code.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#10
|
|||
|
|||
|
Quote:
The refs I'm reading: http://msdn.microsoft.com/en-us/libr...ice.12%29.aspx http://msdn.microsoft.com/en-us/libr...ice.12%29.aspx Code:
Sub setTableBorders()
Dim wrdApp As Object
Set wrdApp = CreateObject("Word.Application")
Dim wrdDoc As Object
Set wrdDoc = wrdApp.documents.Add
wrdApp.Visible = True
' Dim wrdTbl As Table doesn't work in Excel VBA
Dim wrdTbl As Object
Set wrdTbl = wrdDoc.Tables.Add(Range:=wrdDoc.Range, _
NumRows:=4, _
NumColumns:=1)
With wrdTbl
For r = 1 To 4
.Cell(r, 1).Range.Text = ActiveSheet.Cells(r, 1).Value
Next r
''''''''''''
.wdBorderTop.wdLineStyle = 1
''''''''''''
End With
End Sub
|
|
#11
|
||||
|
||||
|
Hi tinfanide,
Those links have the Word parameter names in the left column, and their values in the adjacent column. Based on what's in the links, you'd change: .Borders(wdBorderTop).LineStyle = wdLineStyleSingle to: .Borders(-1).LineStyle = 1 Quite simple, really.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#12
|
|||
|
|||
|
Quote:
But why should Word Automation in Excel or controlling one application in another application be like this? I mean must use the numeric values instead of Application Names in this case of late binding? Is it because numeric values are shared by different versions of Office? Application Names are varied? |
|
#13
|
||||
|
||||
|
Hi tinfanide,
This issue is that, when using late binding, the calling app has no access to the called app's object model until the code is compiled. In this case, Excel has no way of knowing what wdBorderTop or wdLineStyleSingle, for example, are. FWIW, if you'd prefer to leave the parameters unchanged, you could declare them beforehand with code like: Const wdBorderTop As Long = -1 Const wdLineStyleSingle As Long = 1 This has the advantage that expressions like: .Borders(wdBorderTop).LineStyle = wdLineStyleSingle are much easier to interpret than: .Borders(-1).LineStyle = 1
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#14
|
|||
|
|||
|
Quote:
|
|
#15
|
||||
|
||||
|
Hi tinfanide,
You'd only declare each Const variable once. IMHO, having them makes the transition from early to late binding much easier than having to change each & every occurence to the numeric value. For example, you have 6 occurrences of wdLineStyleSingle and 12 of wdLineStyleNone, plus numerous references to wdBorder types. Each of these can be handled via a single Const variable: one for wdLineStyleSingle; and one for wdLineStyleNone. Furthermore, the code will be easier for anyone to maintain that way and, if you revert to early binding later on, you can simply add the Office reference, delete the Const variables and re-set the 'Object' declarations to what you had previously.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
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 |
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 |