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