xref: /aoo4110/main/sw/source/ui/vba/vbaselection.cxx (revision b1cdbd2c)
1 /**************************************************************
2  *
3  * Licensed to the Apache Software Foundation (ASF) under one
4  * or more contributor license agreements.  See the NOTICE file
5  * distributed with this work for additional information
6  * regarding copyright ownership.  The ASF licenses this file
7  * to you under the Apache License, Version 2.0 (the
8  * "License"); you may not use this file except in compliance
9  * with the License.  You may obtain a copy of the License at
10  *
11  *   http://www.apache.org/licenses/LICENSE-2.0
12  *
13  * Unless required by applicable law or agreed to in writing,
14  * software distributed under the License is distributed on an
15  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
16  * KIND, either express or implied.  See the License for the
17  * specific language governing permissions and limitations
18  * under the License.
19  *
20  *************************************************************/
21 
22 
23 #include "vbaselection.hxx"
24 #include <vbahelper/vbahelper.hxx>
25 #include <tools/diagnose_ex.h>
26 #include "vbarange.hxx"
27 #include "vbafind.hxx"
28 #include "wordvbahelper.hxx"
29 #include <com/sun/star/text/XTextRange.hpp>
30 #include <com/sun/star/text/XTextTable.hpp>
31 #include <com/sun/star/text/XTextTableCursor.hpp>
32 #include <com/sun/star/text/ControlCharacter.hpp>
33 #include <com/sun/star/table/XCell.hpp>
34 #include <ooo/vba/word/WdUnits.hpp>
35 #include <ooo/vba/word/WdMovementType.hpp>
36 #include <ooo/vba/word/WdGoToItem.hpp>
37 #include <ooo/vba/word/WdGoToDirection.hpp>
38 #include <ooo/vba/word/XBookmark.hpp>
39 #include <ooo/vba/word/XApplication.hpp>
40 #include <com/sun/star/text/XPageCursor.hpp>
41 #include "unotbl.hxx"
42 #include "unocoll.hxx"
43 #include "vbatable.hxx"
44 #include <com/sun/star/view/XSelectionSupplier.hpp>
45 #include <com/sun/star/view/XViewCursor.hpp>
46 #include <ooo/vba/word/WdInformation.hpp>
47 #include <ooo/vba/word/WdHeaderFooterIndex.hpp>
48 #include "vbainformationhelper.hxx"
49 #include "vbafield.hxx"
50 #include "vbaheaderfooter.hxx"
51 #include "vbaheaderfooterhelper.hxx"
52 #include <vbahelper/vbashaperange.hxx>
53 #include <com/sun/star/drawing/XDrawPageSupplier.hpp>
54 #include <com/sun/star/drawing/XDrawPage.hpp>
55 
56 using namespace ::ooo::vba;
57 using namespace ::com::sun::star;
58 
SwVbaSelection(const uno::Reference<ooo::vba::XHelperInterface> & rParent,const uno::Reference<uno::XComponentContext> & rContext,const uno::Reference<frame::XModel> & rModel)59 SwVbaSelection::SwVbaSelection( const uno::Reference< ooo::vba::XHelperInterface >& rParent, const uno::Reference< uno::XComponentContext >& rContext, const uno::Reference< frame::XModel >& rModel ) throw ( uno::RuntimeException ) : SwVbaSelection_BASE( rParent, rContext ), mxModel( rModel )
60 {
61     mxTextViewCursor = word::getXTextViewCursor( mxModel );
62 }
63 
~SwVbaSelection()64 SwVbaSelection::~SwVbaSelection()
65 {
66 }
67 
GetSelectedRange()68 uno::Reference< text::XTextRange > SwVbaSelection::GetSelectedRange() throw ( uno::RuntimeException )
69 {
70     uno::Reference< text::XTextRange > xTextRange;
71     uno::Reference< lang::XServiceInfo > xServiceInfo( mxModel->getCurrentSelection(), uno::UNO_QUERY_THROW );
72     if( xServiceInfo->supportsService( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("com.sun.star.text.TextRanges") ) ) )
73     {
74         uno::Reference< container::XIndexAccess > xTextRanges( xServiceInfo, uno::UNO_QUERY_THROW );
75         if( xTextRanges->getCount() > 0 )
76         {
77             // if there are multipul selection, just return the last selected Range.
78             xTextRange.set( xTextRanges->getByIndex( xTextRanges->getCount()-1 ), uno::UNO_QUERY_THROW );
79         }
80     }
81     else
82     {
83         throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
84     }
85     return xTextRange;
86 }
87 
88 uno::Reference< word::XRange > SAL_CALL
getRange()89 SwVbaSelection::getRange() throw ( uno::RuntimeException )
90 {
91     uno::Reference< text::XTextRange > xTextRange = GetSelectedRange();
92     uno::Reference< text::XTextDocument > xDocument( mxModel, uno::UNO_QUERY_THROW );
93     return uno::Reference< word::XRange >( new SwVbaRange( this, mxContext, xDocument, xTextRange->getStart(), xTextRange->getEnd(), mxTextViewCursor->getText() ) );
94 }
95 
96 rtl::OUString SAL_CALL
getText()97 SwVbaSelection::getText() throw ( uno::RuntimeException )
98 {
99     return getRange()->getText();
100 }
101 
102 void SAL_CALL
setText(const rtl::OUString & rText)103 SwVbaSelection::setText( const rtl::OUString& rText ) throw ( uno::RuntimeException )
104 {
105     getRange()->setText( rText );
106 }
107 
108 void SAL_CALL
TypeText(const rtl::OUString & rText)109 SwVbaSelection::TypeText( const rtl::OUString& rText ) throw ( uno::RuntimeException )
110 {
111     // FIXME: handle the property Options.ReplaceSelection, the default value is sal_True
112     setText( rText );
113 }
114 
115 void SAL_CALL
HomeKey(const uno::Any & _unit,const uno::Any & _extend)116 SwVbaSelection::HomeKey( const uno::Any& _unit, const uno::Any& _extend ) throw ( uno::RuntimeException )
117 {
118     sal_Int32 nUnit = word::WdUnits::wdLine;
119     sal_Int32 nExtend = word::WdMovementType::wdMove;
120     _unit >>= nUnit;
121     _extend >>= nExtend;
122 
123     switch( nUnit )
124     {
125         case word::WdUnits::wdStory:
126         {
127             // go to the begin of the document
128             rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:GoToStartOfDoc"));
129             dispatchRequests( mxModel,url );
130             // If something is selected, it needs to go twice
131             dispatchRequests( mxModel,url );
132             break;
133         }
134         case word::WdUnits::wdLine:
135         {
136             // go to the begin of the Line
137             rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:GoToStartOfLine"));
138             dispatchRequests( mxModel,url );
139             break;
140         }
141         default:
142         {
143             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
144             break;
145         }
146     }
147 }
148 
149 void SAL_CALL
EndKey(const uno::Any & _unit,const uno::Any & _extend)150 SwVbaSelection::EndKey( const uno::Any& _unit, const uno::Any& _extend ) throw ( uno::RuntimeException )
151 {
152     sal_Int32 nUnit = word::WdUnits::wdLine;
153     sal_Int32 nExtend = word::WdMovementType::wdMove;
154     _unit >>= nUnit;
155     _extend >>= nExtend;
156 
157     switch( nUnit )
158     {
159         case word::WdUnits::wdStory:
160         {
161             // go to the end of the document
162             rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:GoToEndOfDoc"));
163             dispatchRequests( mxModel,url );
164             // If something is selected, it needs to go twice
165             dispatchRequests( mxModel,url );
166             break;
167         }
168         case word::WdUnits::wdLine:
169         {
170             // go to the end of the Line
171             rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:GoToEndOfLine"));
172             dispatchRequests( mxModel,url );
173             break;
174         }
175         default:
176         {
177             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
178             break;
179         }
180     }
181 }
182 
183 void SAL_CALL
Delete(const uno::Any &,const uno::Any &)184 SwVbaSelection::Delete( const uno::Any& /*_unit*/, const uno::Any& /*_count*/ ) throw ( uno::RuntimeException )
185 {
186     // FIXME: handle the arguments: _unit and _count
187     rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:Delete"));
188     dispatchRequests( mxModel,url );
189 }
190 
NextCell(sal_Int32 nCount,E_DIRECTION eDirection)191 void SwVbaSelection::NextCell( sal_Int32 nCount, E_DIRECTION eDirection ) throw ( uno::RuntimeException )
192 {
193     uno::Reference< beans::XPropertySet > xCursorProps( mxTextViewCursor, uno::UNO_QUERY_THROW );
194     uno::Reference< text::XTextTable > xTextTable;
195     uno::Reference< table::XCell > xCell;
196     xCursorProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("TextTable") ) ) >>= xTextTable;
197     xCursorProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Cell") ) ) >>= xCell;
198     if( !xTextTable.is() || !xCell.is() )
199     {
200         DebugHelper::exception(SbERR_BAD_ARGUMENT, rtl::OUString());
201         return;
202     }
203     uno::Reference< beans::XPropertySet > xCellProps( xCell, uno::UNO_QUERY_THROW );
204     rtl::OUString aCellName;
205     xCellProps->getPropertyValue( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("CellName") ) ) >>= aCellName;
206     uno::Reference< text::XTextTableCursor > xTextTableCursor = xTextTable->createCursorByCellName( aCellName );
207     // move the table cursor
208     switch( eDirection )
209     {
210         case MOVE_LEFT:
211         {
212             xTextTableCursor->goLeft( nCount, sal_False );
213             break;
214         }
215         case MOVE_RIGHT:
216         {
217             xTextTableCursor->goRight( nCount, sal_False );
218             break;
219         }
220         case MOVE_UP:
221         {
222             xTextTableCursor->goUp( nCount, sal_False );
223             break;
224         }
225         case MOVE_DOWN:
226         {
227             xTextTableCursor->goDown( nCount, sal_False );
228             break;
229         }
230         default:
231         {
232             DebugHelper::exception(SbERR_BAD_ARGUMENT, rtl::OUString());
233             return;
234         }
235     }
236     // move the view cursor
237     xCell = xTextTable->getCellByName( xTextTableCursor->getRangeName() );
238     mxTextViewCursor->gotoRange( uno::Reference< text::XTextRange >( xCell, uno::UNO_QUERY_THROW ), sal_False );
239 }
240 
241 void SAL_CALL
MoveRight(const uno::Any & _unit,const uno::Any & _count,const uno::Any & _extend)242 SwVbaSelection::MoveRight( const uno::Any& _unit, const uno::Any& _count, const uno::Any& _extend ) throw ( uno::RuntimeException )
243 {
244     sal_Int32 nUnit = word::WdUnits::wdCharacter;
245     sal_Int32 nCount = 1;
246     sal_Int32 nExtend = word::WdMovementType::wdMove;
247 
248     if( _unit.hasValue() )
249         _unit >>= nUnit;
250     if( _count.hasValue() )
251         _count >>= nCount;
252     if( _extend.hasValue() )
253         _extend >>= nExtend;
254 
255     if( nCount == 0 )
256         return;
257 
258     if( nCount < 0 )
259     {
260         // TODO: call MoveLeft;
261         MoveLeft( _unit, uno::makeAny( -nCount ), _extend );
262         return;
263     }
264 
265     switch( nUnit )
266     {
267         case word::WdUnits::wdCell:
268         {
269             if(  nExtend == word::WdMovementType::wdExtend )
270             {
271                 DebugHelper::exception(SbERR_BAD_ARGUMENT, rtl::OUString());
272                 return;
273             }
274             NextCell( nCount, MOVE_RIGHT );
275             break;
276         }
277         default:
278         {
279             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
280             break;
281         }
282     }
283 
284 }
285 
286 void SAL_CALL
MoveLeft(const uno::Any & _unit,const uno::Any & _count,const uno::Any & _extend)287 SwVbaSelection::MoveLeft( const uno::Any& _unit, const uno::Any& _count, const uno::Any& _extend ) throw ( uno::RuntimeException )
288 {
289     sal_Int32 nUnit = word::WdUnits::wdCharacter;
290     sal_Int32 nCount = 1;
291     sal_Int32 nExtend = word::WdMovementType::wdMove;
292 
293     if( _unit.hasValue() )
294         _unit >>= nUnit;
295     if( _count.hasValue() )
296         _count >>= nCount;
297     if( _extend.hasValue() )
298         _extend >>= nExtend;
299 
300     if( nCount == 0 )
301         return;
302 
303     if( nCount < 0 )
304     {
305         MoveRight( _unit, uno::makeAny( -nCount ), _extend );
306         return;
307     }
308 
309     switch( nUnit )
310     {
311         case word::WdUnits::wdCell:
312         {
313             if(  nExtend == word::WdMovementType::wdExtend )
314             {
315                 DebugHelper::exception(SbERR_BAD_ARGUMENT, rtl::OUString());
316                 return;
317             }
318             NextCell( nCount, MOVE_LEFT );
319             break;
320         }
321         default:
322         {
323             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
324             break;
325         }
326     }
327 
328 }
329 
330 void SAL_CALL
MoveDown(const uno::Any & _unit,const uno::Any & _count,const uno::Any & _extend)331 SwVbaSelection::MoveDown( const uno::Any& _unit, const uno::Any& _count, const uno::Any& _extend ) throw ( uno::RuntimeException )
332 {
333     sal_Int32 nUnit = word::WdUnits::wdCharacter;
334     sal_Int32 nCount = 1;
335     sal_Int32 nExtend = word::WdMovementType::wdMove;
336 
337     if( _unit.hasValue() )
338         _unit >>= nUnit;
339     if( _count.hasValue() )
340         _count >>= nCount;
341     if( _extend.hasValue() )
342         _extend >>= nExtend;
343 
344     if( nCount == 0 )
345         return;
346 
347     if( nCount < 0 )
348     {
349         // TODO: call MoveLeft;
350         //MoveUp( _unit, uno::makeAny( -nCount ), _extend );
351         return;
352     }
353 
354     switch( nUnit )
355     {
356         case word::WdUnits::wdLine:
357         {
358             uno::Reference< view::XViewCursor > xViewCursor( mxTextViewCursor, uno::UNO_QUERY_THROW );
359             sal_Bool bExpand = ( nExtend == word::WdMovementType::wdMove ) ? sal_False : sal_True;
360             xViewCursor->goDown( nCount, bExpand );
361             break;
362         }
363         default:
364         {
365             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
366             break;
367         }
368     }
369 
370 }
371 
372 void SAL_CALL
TypeParagraph()373 SwVbaSelection::TypeParagraph() throw ( uno::RuntimeException )
374 {
375     // #FIXME: if the selection is an entire paragraph, it's replaced
376     // by the new paragraph
377     sal_Bool isCollapsed = mxTextViewCursor->isCollapsed();
378     InsertParagraph();
379     if( isCollapsed )
380         mxTextViewCursor->collapseToStart();
381 }
382 
383 void SAL_CALL
InsertParagraph()384 SwVbaSelection::InsertParagraph() throw ( uno::RuntimeException )
385 {
386     // #FIME: the selection should include the new paragraph.
387     getRange()->InsertParagraph();
388 }
389 
390 void SAL_CALL
InsertParagraphBefore()391 SwVbaSelection::InsertParagraphBefore() throw ( uno::RuntimeException )
392 {
393     getRange()->InsertParagraphBefore();
394 }
395 
396 void SAL_CALL
InsertParagraphAfter()397 SwVbaSelection::InsertParagraphAfter() throw ( uno::RuntimeException )
398 {
399     getRange()->InsertParagraphAfter();
400 }
401 
402 uno::Reference< word::XParagraphFormat > SAL_CALL
getParagraphFormat()403 SwVbaSelection::getParagraphFormat() throw ( uno::RuntimeException )
404 {
405     return getRange()->getParagraphFormat();
406 }
407 
408 void SAL_CALL
setParagraphFormat(const uno::Reference<word::XParagraphFormat> & rParagraphFormat)409 SwVbaSelection::setParagraphFormat( const uno::Reference< word::XParagraphFormat >& rParagraphFormat ) throw ( uno::RuntimeException )
410 {
411     return getRange()->setParagraphFormat( rParagraphFormat );
412 }
413 
414 uno::Reference< word::XFind > SAL_CALL
getFind()415 SwVbaSelection::getFind() throw ( uno::RuntimeException )
416 {
417     uno::Reference< text::XTextRange > xTextRange = GetSelectedRange();
418     return uno::Reference< word::XFind >( new SwVbaFind( this, mxContext, mxModel, xTextRange ) );
419 }
420 
421 uno::Reference< word::XStyle > SAL_CALL
getStyle()422 SwVbaSelection::getStyle() throw ( uno::RuntimeException )
423 {
424     return getRange()->getStyle();
425 }
426 
427 void SAL_CALL
setStyle(const uno::Reference<word::XStyle> & rStyle)428 SwVbaSelection::setStyle( const uno::Reference< word::XStyle >& rStyle ) throw ( uno::RuntimeException )
429 {
430     return getRange()->setStyle( rStyle );
431 }
432 
433 uno::Reference< word::XFont > SAL_CALL
getFont()434 SwVbaSelection::getFont() throw ( uno::RuntimeException )
435 {
436     return getRange()->getFont();
437 }
438 
439 void SAL_CALL
TypeBackspace()440 SwVbaSelection::TypeBackspace() throw ( uno::RuntimeException )
441 {
442     rtl::OUString url = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( ".uno:SwBackspace"));
443     dispatchRequests( mxModel,url );
444 }
445 
GoTo(const uno::Any & _what,const uno::Any & _which,const uno::Any & _count,const uno::Any & _name)446 uno::Reference< word::XRange > SAL_CALL SwVbaSelection::GoTo( const uno::Any& _what, const uno::Any& _which, const uno::Any& _count, const uno::Any& _name ) throw (uno::RuntimeException)
447 {
448     sal_Int32 nWhat = 0;
449     if( ( _what >>= nWhat ) != sal_True )
450          DebugHelper::exception(SbERR_BAD_ARGUMENT, rtl::OUString());
451     switch( nWhat )
452     {
453         case word::WdGoToItem::wdGoToBookmark:
454         {
455             rtl::OUString sName;
456             uno::Reference< word::XApplication > xApplication( Application(), uno::UNO_QUERY_THROW );
457             uno::Reference< word::XBookmark > xBookmark( xApplication->getActiveDocument()->Bookmarks(_name), uno::UNO_QUERY_THROW );
458             xBookmark->Select();
459             //return uno::Reference< word::XRange >( xBookmark->Range(), uno::UNO_QUERY_THROW );
460             break;
461         }
462         case word::WdGoToItem::wdGoToPage:
463         {
464             uno::Reference< text::XPageCursor > xPageCursor( mxTextViewCursor, uno::UNO_QUERY_THROW );
465             sal_Int32 nCurrPage = xPageCursor->getPage();
466             sal_Int32 nLastPage = word::getPageCount( mxModel );
467             sal_Int32 nCount = 0;
468             if( _count.hasValue() )
469                 _count >>= nCount;
470             sal_Int32 nWhich = 0;
471             if( _which.hasValue() )
472                 _which >>= nWhich;
473              sal_Int32 nPage = 0;
474              switch( nWhich )
475              {
476                 case word::WdGoToDirection::wdGoToLast:
477                 {
478                     nPage = nLastPage;
479                     break;
480                 }
481                 case word::WdGoToDirection::wdGoToNext:
482                 {
483                     nPage = nCurrPage + 1;
484                     break;
485                 }
486                 case word::WdGoToDirection::wdGoToPrevious:
487                 {
488                     nPage = nCurrPage - 1;
489                     break;
490                 }
491                 default:
492                 {
493                     nPage = nCount;
494                 }
495              }
496              if( nPage <= 0 )
497                 nPage = 1;
498              if( nPage > nLastPage )
499                 nPage = nLastPage;
500              xPageCursor->jumpToPage( ( sal_Int16 )( nPage ) );
501              break;
502         }
503         case word::WdGoToItem::wdGoToSection:
504         {
505             // TODO: implement Section object
506         }
507         default:
508             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
509     }
510     return getRange();
511 }
512 
getLanguageID()513 ::sal_Int32 SAL_CALL SwVbaSelection::getLanguageID() throw (uno::RuntimeException)
514 {
515     return getRange()->getLanguageID();
516 }
517 
setLanguageID(::sal_Int32 _languageid)518 void SAL_CALL SwVbaSelection::setLanguageID( ::sal_Int32 _languageid ) throw (uno::RuntimeException)
519 {
520     getRange()->setLanguageID( _languageid );
521 }
522 
Information(sal_Int32 _type)523 uno::Any SAL_CALL SwVbaSelection::Information( sal_Int32 _type ) throw (uno::RuntimeException)
524 {
525     uno::Any result;
526     //uno::Reference< view::XSelectionSupplier > xSel( mxModel->getCurrentController(), uno::UNO_QUERY_THROW );
527     //uno::Any aSelectedObject = xSel->getSelection();
528     switch( _type )
529     {
530         case word::WdInformation::wdActiveEndPageNumber:
531         {
532             result = uno::makeAny( SwVbaInformationHelper::handleWdActiveEndPageNumber( mxTextViewCursor ) );
533             break;
534         }
535         case word::WdInformation::wdNumberOfPagesInDocument:
536         {
537             result = uno::makeAny( SwVbaInformationHelper::handleWdNumberOfPagesInDocument( mxModel ) );
538             break;
539         }
540         case word::WdInformation::wdVerticalPositionRelativeToPage:
541         {
542             result = uno::makeAny( SwVbaInformationHelper::handleWdVerticalPositionRelativeToPage( mxModel, mxTextViewCursor ) );
543             break;
544         }
545         default:
546             throw uno::RuntimeException( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("Not implemented") ), uno::Reference< uno::XInterface >() );
547     }
548     // This method fails to restore the previouse selection
549     //xSel->select( aSelectedObject );
550     return result;
551 }
552 
InsertBreak(const uno::Any & _breakType)553 void SAL_CALL SwVbaSelection::InsertBreak( const uno::Any& _breakType ) throw (uno::RuntimeException)
554 {
555     getRange()->InsertBreak( _breakType );
556 }
557 
558 uno::Any SAL_CALL
Tables(const uno::Any & aIndex)559 SwVbaSelection::Tables( const uno::Any& aIndex ) throw (uno::RuntimeException)
560 {
561     // Hacky implementation due to missing api ( and lack of knowledge )
562     // we can only support a selection that is a single table
563     if ( !aIndex.hasValue() ) // currently we can't support multiple tables in a selection
564        throw uno::RuntimeException();
565     // if the current selection is a XTextTableCursor and the index is 1 then we can service this request, otherwise we just have to throw
566     uno::Reference< text::XTextTableCursor > xTextTableCursor( mxModel->getCurrentSelection(), uno::UNO_QUERY );
567 
568     if ( !xTextTableCursor.is() )
569        throw uno::RuntimeException();
570 
571     sal_Int32 nIndex = 0;
572     aIndex >>= nIndex;
573 
574     uno::Any aRet;
575 
576     if ( nIndex != 1 )
577        throw uno::RuntimeException();
578     SwXTextTableCursor* pTTCursor = dynamic_cast< SwXTextTableCursor* >( xTextTableCursor.get() );
579     if ( pTTCursor )
580     {
581         SwFrmFmt* pFmt = pTTCursor->GetFrmFmt();
582         rtl::OUString sTableName;
583         if ( pFmt )
584         {
585             uno::Reference< text::XTextTable > xTbl = SwXTextTables::GetObject(*pFmt);
586             uno::Reference< css::text::XTextDocument > xTextDoc( mxModel, uno::UNO_QUERY_THROW );
587             uno::Reference< word::XTable > xVBATbl = new SwVbaTable( mxParent, mxContext, xTextDoc, xTbl );
588             aRet <<= xVBATbl;
589         }
590     }
591     return aRet;
592 
593 }
594 
595 uno::Any SAL_CALL
Fields(const uno::Any & index)596 SwVbaSelection::Fields( const uno::Any& index ) throw (uno::RuntimeException)
597 {
598     uno::Reference< XCollection > xCol( new SwVbaFields( mxParent, mxContext, mxModel ) );
599     if ( index.hasValue() )
600         return xCol->Item( index, uno::Any() );
601     return uno::makeAny( xCol );
602 }
603 
604 uno::Reference< word::XHeaderFooter > SAL_CALL
getHeaderFooter()605 SwVbaSelection::getHeaderFooter() throw ( uno::RuntimeException )
606 {
607     uno::Reference< text::XText > xCurrentText = word::getXTextViewCursor( mxModel )->getText();
608     if( HeaderFooterHelper::isHeader( mxModel, xCurrentText ) || HeaderFooterHelper::isFooter( mxModel, xCurrentText ) )
609     {
610         uno::Reference< beans::XPropertySet > xPageStyleProps( word::getCurrentPageStyle( mxModel ), uno::UNO_QUERY_THROW );
611         sal_Int32 nIndex = word::WdHeaderFooterIndex::wdHeaderFooterPrimary;
612         sal_Bool isHeader = HeaderFooterHelper::isHeader( mxModel, xCurrentText );
613         if( HeaderFooterHelper::isEvenPagesHeader( mxModel, xCurrentText ) || HeaderFooterHelper::isEvenPagesFooter( mxModel, xCurrentText ) )
614             nIndex = word::WdHeaderFooterIndex::wdHeaderFooterEvenPages;
615         else if( HeaderFooterHelper::isFirstPageHeader( mxModel, xCurrentText ) || HeaderFooterHelper::isFirstPageFooter( mxModel, xCurrentText ) )
616             nIndex = word::WdHeaderFooterIndex::wdHeaderFooterFirstPage;
617 
618         return uno::Reference< word::XHeaderFooter >( new SwVbaHeaderFooter( this, mxContext, mxModel, xPageStyleProps, isHeader, nIndex ) );
619 
620     }
621     return uno::Reference< word::XHeaderFooter >();
622 }
623 
624 uno::Any SAL_CALL
ShapeRange()625 SwVbaSelection::ShapeRange( ) throw (uno::RuntimeException)
626 {
627     uno::Reference< drawing::XShapes > xShapes( mxModel->getCurrentSelection(), uno::UNO_QUERY );
628 
629     if ( !xShapes.is() )
630        throw uno::RuntimeException();
631 
632     uno::Reference< drawing::XDrawPageSupplier > xDrawPageSupplier( mxModel, uno::UNO_QUERY_THROW );
633     uno::Reference< drawing::XDrawPage > xDrawPage = xDrawPageSupplier->getDrawPage();
634     uno::Reference< container::XIndexAccess > xShapesAccess( xShapes, uno::UNO_QUERY_THROW );
635     return uno::makeAny( uno::Reference< msforms::XShapeRange >( new ScVbaShapeRange( this, mxContext, xShapesAccess, xDrawPage, mxModel ) ) );
636 }
637 
getStart()638 ::sal_Int32 SAL_CALL SwVbaSelection::getStart() throw (uno::RuntimeException)
639 {
640     return getRange()->getStart();
641 }
642 
setStart(::sal_Int32 _start)643 void SAL_CALL SwVbaSelection::setStart( ::sal_Int32 _start ) throw (uno::RuntimeException)
644 {
645     getRange()->setStart( _start );
646 }
getEnd()647 ::sal_Int32 SAL_CALL SwVbaSelection::getEnd() throw (uno::RuntimeException)
648 {
649     return getRange()->getEnd();
650 }
651 
setEnd(::sal_Int32 _end)652 void SAL_CALL SwVbaSelection::setEnd( ::sal_Int32 _end ) throw (uno::RuntimeException)
653 {
654     getRange()->setEnd( _end );
655 }
656 
657 rtl::OUString&
getServiceImplName()658 SwVbaSelection::getServiceImplName()
659 {
660 	static rtl::OUString sImplName( RTL_CONSTASCII_USTRINGPARAM("SwVbaSelection") );
661 	return sImplName;
662 }
663 
664 uno::Sequence< rtl::OUString >
getServiceNames()665 SwVbaSelection::getServiceNames()
666 {
667 	static uno::Sequence< rtl::OUString > aServiceNames;
668 	if ( aServiceNames.getLength() == 0 )
669 	{
670 		aServiceNames.realloc( 1 );
671 		aServiceNames[ 0 ] = rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ooo.vba.word.Selection" ) );
672 	}
673 	return aServiceNames;
674 }
675 
676