In word I am looking for a keyboard short cut which allows me to move the paragraph in which my cursor currently is one paragraph/line up or down.
I am new to VBA etc, but found this
Sub OutlineMoveUp()
Selection.Range.Relocate wdRelocateUp
End Sub
This comes pretty close to what I am looking for, but seems to move the paragraph up according to its position in the outline structure (what can become rather confusing). I just want to move it one paragraph/line up or down (also irrespective of its formatting).
(RStudio offers this nice feature where you can simply move selected text lines without copy-pasting; I am looking for the equivalent in word).
many thx.
The Relocate method is designed to work in Outline mode see here. Try the Move method instead:
Selection.Range.Move Unit:=wdParagraph, Count:=-1
You may need to adjust Count to get the effect you desire --- if -1 doesn't work, try -2, etc.
This would probably be cleaner using cut/paste but try this:
Sub Test_NewP()
Dim doc As Word.Document
Dim CurR As Word.Range
Dim NewP As Word.Paragraph
Dim IndexP As Long
Set doc = ActiveDocument
If doc.ActiveWindow.View = wdOutlineView Then
MsgBox "This program doesn't work in outline view --- please switch to another view", vbOKOnly, "Error"
Exit Sub
End If
Set CurR = Selection.Paragraphs(1).Range
IndexP = doc.Range(0, CurR.End).Paragraphs.Count
Set NewP = doc.Paragraphs.Add(doc.Paragraphs(IndexP - 1).Range)
NewP.Range.Text = CurR.Text
CurR.Delete
Set NewP = Nothing
Set CurR = Nothing
Set doc = Nothing
End Sub
This likely won't reliably manage formatting, but you could add code to fix that.
Hope that helps.
Related
i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub
I hope my first post will be OK and not offend (I've tried to follow the guide and done a lot of searching).
I've modified the below code from Greg Maxey (https://gregmaxey.com/word_tip_pages/word_fields.html) to update links in my Word document to an Excel workbook. It seems to be the most used code for this purpose. The reason I changed his code was to try to do away with the need to have a counter variable like i, and using a For i = 1 to .Fields.Count Then... Next i structure.
When I run it as is, it gets stuck in a loop only updating the first field in the Word document. To see this, I put in the Debug.Print wrdField.Index line. It repeatedly outputs 1, so it is not moving to the Next wrdField as I expect (the code actually just used Next, but it's the same result if I use Next wrdField).
When I comment out .AutoUpdate = False, it works properly:
Public Sub UpdateExternalLinksToCurrentFolder()
Dim wrdDocument As Word.Document
Dim wrdField As Word.Field
Dim strCurrentLinkedWorkbookPath, strNewLinkedWorkbookPath As String
Dim strCurrentLinkedWorkbookName, strNewLinkedWorkbookName As String
Dim strCurrentLinkedWorkbookFullName, strNewLinkedWorkbookFullName As String
Dim strThisDocumentPath As String
'On Error GoTo ErrorHandler_UpdateExternalLinksToCurrentFolder
Application.ScreenUpdating = False
Set wrdDocument = ActiveDocument
strThisDocumentPath = wrdDocument.Path & Application.PathSeparator
strNewLinkedWorkbookPath = strThisDocumentPath
With wrdDocument
For Each wrdField In .Fields
With wrdField
If .Type = wdFieldLink Then
With .LinkFormat
Debug.Print wrdField.Index
strCurrentLinkedWorkbookPath = .SourcePath & Application.PathSeparator
strCurrentLinkedWorkbookName = .SourceName
strNewLinkedWorkbookName = strCurrentLinkedWorkbookName
strNewLinkedWorkbookFullName = strNewLinkedWorkbookPath & strNewLinkedWorkbookName
.AutoUpdate = False
End With
.Code.Text = VBA.Replace(.Code.Text, Replace(strCurrentLinkedWorkbookPath, "\", "\\"), Replace(strNewLinkedWorkbookPath, "\", "\\"))
End If
End With
Next
End With
Set wrdDocument = Nothing
Application.ScreenUpdating = True
Exit Sub
Can anyone tell my why it's behaving this way? When I set .AutoUpdate = False, am I changing something about the link field or doing something to the Word document that causes the .wrdField.Index to reset to 1? I can't find anything online documenting this behavior and it's driving me nuts.
Behind the scenes, what's happening is that Word recreates the content and the field. The orginal linked content is removed and new content inserted. So that essentially destroys the field and recreates it. A user won't notice this, but VBA does.
When dealing with a loop situation that uses an index and the looped items are being removed, it's therefore customary to loop backwards (from the end of the document to the beginning). Which cannot be done with For...Each.
In MS Word, you can create hyperlinks to a "Place in this document" so that a link takes you someplace else in the same Word file. However, if you change headers or move things around these links will sometimes break. I want to write some VBA to check for broken links.
With VBA, you can list each hyperlink subaddress using the code below:
Sub CheckLinks()
Set doc = ActiveDocument
Dim i
For i = 1 To doc.Hyperlinks.Count
Debug.Print doc.Hyperlinks(i).SubAddress
Next
End Sub
The output from the code above also matches what is shown in the field codes for the hyperlink.
However, I'm not really clear on how to verify if the SubAddress is correct. For example, an excerpt from the program output shows this:
_Find_a_Staff_1
_Edit_Organization_Settings_2
_Set_the_Staff
_Find_a_Staff_1
But there's no obvious way to tell what the "correct" suffix should be for a given heading. Any thoughts on how to check if these are valid?
Is there a way to get the list of all valid subaddresses for the headings in the document?
The code below will list the hyperlinks where the corresponding bookmark does not exist in the document. (Note that it only detects missing links, not links that go to the wrong place.)
Sub CheckLinks()
Dim doc As Document
Set doc = ActiveDocument
Dim i, j
Dim found As Boolean
For i = 1 To doc.Hyperlinks.Count
found = False
For j = 1 To doc.Bookmarks.Count
If doc.Range.Bookmarks(j).Name = doc.Hyperlinks(i).SubAddress Then
found = True
End If
Next
If found = False Then
Debug.Print doc.Hyperlinks(i).SubAddress
End If
Next
End Sub
I created code to set the pagebreaks in an excel report to deal with the orphan issue (i.e. one line of text spills over onto the next page, etc.). The code works fine when I run it with the report open / visible.
It is part of a larger application which is opened and the code executed from MS Access. Excel is not visible during the process to improve performance.
When I run my code from MS Access it no longer works... it doesn't produce an error, but simply ignores the actual pagebreak setting command.
I read on various forums that in order to avoid this problem, excel needs to be first switched over to ActiveWindow.View = xlPageBreakPreview, but that doesn't work either (I suspect since Excel isn't visible).
I have tested for the following:
Code works when it is started manually or stepped through with F8
Code is executed when called upon from Access (I set breakpoints)
Switching the window view doesn't do anything either
How can I get Excel to change the pagebreaks via code when Excel is run in the background?
This is my code:
Sub TheOrphanProblem()
Dim iPageBrkRow
'Determine if there are page breaks and if so on which row of the document
If FindNthAutoPageBreak(wsRptHolding, 1) Is Nothing Then
'No pagebreak found so we exit the sub
Exit Sub
Else
iPageBrkRow = FindNthAutoPageBreak(wsRptHolding, 1).Row 'Get row
End If
Debug.Print iPageBrkRow
Dim x As Integer
Dim sCase As String
Dim rNewposition As Range
With wsRptHolding
'Code edited out for brevity. This part checks if there is an orphan problem and finds the new position for a pagebreak if needed.
It then provides that position as a range called "rNewposition".
'Moves page break to calculated position
ActiveWindow.View = xlPageBreakPreview
.HPageBreaks.Add rNewposition
ActiveWindow.View = xlNormalView
End With
End Sub
This is the code I use to find the pagebreak positions...
Private Function FindNthAutoPageBreak(Sht As Worksheet, Nth As Long) As Range
'Set page break of the last page so that sub asset groups are kept together
Dim HP As HPageBreak
Dim Ctr As Long
For Each HP In Sht.HPageBreaks
If HP.Type = xlPageBreakAutomatic Then
Ctr = Ctr + 1
If Ctr = Nth Then
Set FindNthAutoPageBreak = HP.Location
End If
End If
Next HP
End Function
Try this
ActiveSheet.DisplayPageBreaks = True
I'm currently working with CATIA V5, and I want to use Macros (VBA), but I have some problems!
My question is: how to change the text of a cut view? (see the picture)
I tried to use : myView.Texts.item(1) to access to this "text" but I think that CATIA dont consider it as text...
I want to change this text without the intervention of the user ( without selections), can I do that?
IME, VBA scripting in drafting workbench is quite tricky at first..."MyTexts" is a collection of DrawingText objects.
MyDrawingText.Text = "MyNewTextValue"
The main trouble you will have is getting a handle on the specific text object that you want to modify. I found that the best way around this is to either scan the entire DrawingTexts collection in the DrawingView, and apply a unique name, DrawingText.Name="UniqueObjectName", or you create the drawing text from the script and you can more easily get a handle on the DrawingText object to put whatever value you want in there. Creating Unique Names makes your drawing more robust for future scripting
MyView.Texts.Count will also be useful to get the item number if the last created DrawingText object(s).
I'm happy to further explain if you need. Good luck!
Update/Edit:
As mentioned above, scripting with the drafting workbench is not always straight forward. It turns out that the callout texts do not exactly live in the DrawingTexts collection of a DrawingView, but they do live somewhere inside the drawing view...In this case, you're trying to edit the "ID" of the section view..That property isn't exposed through VBA either.
There is a hack/work-around which is to search the parent view for drawing texts and and then with some logic, which you'll need to come up with, scan the Selection for the texts you want to change. You should rename then while you're at it, this way it's easier to come back and find them again.
Here's an example starting with an Object Resolution of the Front View (the parent view of the section view)
Sub ChangeCallout()
'---- Begin resolution script for object : Front View
Dim drawingDocument1 As DrawingDocument
Set drawingDocument1 = CATIA.ActiveDocument
Dim drawingSheets1 As DrawingSheets
Set drawingSheets1 = drawingDocument1.Sheets
Dim drawingSheet1 As DrawingSheet
Set drawingSheet1 = drawingSheets1.Item("Sheet.1")
Dim drawingViews1 As DrawingViews
Set drawingViews1 = drawingSheet1.Views
Dim drawingView1 As DrawingView
Set drawingView1 = drawingViews1.Item("Front view") 'this is the parent view of the section view
'---- End resolution script
Dim sel As Selection
Set sel = drawingDocument1.Selection
Dim CalloutText As drawingText
sel.Clear 'clear the selection / good practice
sel.Add drawingView1 'add the parent view to the selection
sel.Search "Drafting.Text,sel" 'this will search the current selection for all drawing texts and add them to the selection
Dim thing As Variant
Dim i As Integer
For i = 1 To sel.Count
Set thing = sel.Item2(i)
Set CalloutText = thing.Value
'do some things/logic here to determine if this is a callout with some Ifs or Case statements
'CalloutText.Name = "Useful Unique Name"
'CalloutText.Text = "New Callout Label" 'whatever you want to rename it to
Next
End Sub
the text of the cut view is defined by the view name, to change it you should change the view name as describe bellow:
Sub CATMain()
Dim oDraw As DrawingDocument
Set oDraw = CATIA.ActiveDocument
Dim oSectionView As DrawingView
Set oSectionView = oDraw.Sheets.ActiveSheet.Views.ActiveView
oSectionView.SetViewName "Prefix ", "B", " Suffix"
End Sub
For scanning through the callout texts you can use below lines.
This would select the texts belonging to only callout and doesn't scan through all texts.
Sub CATMain()
Dim drawingDocument1 As Document
Set drawingDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = drawingDocument1.Selection
selection1.Search "CATDrwSearch.DrwCallout,all"
selection1.Search "Drafting.Text,sel"
Dim i As Integer
For i = 1 To selection1.Count
MsgBox selection1.Item(i).Value.text
Next
End Sub