I am trying to create a sort of list that looks something like this:
echo thing1 thing2
echo.
Then a for loop to list text files in a directory and a bit of information like this:
echo %var% %var1%
echo %var% %var1%
rem and so on
But no matter what length the variable is, there will always be 11 spaces which puts it off a bit with the header.
I know I could make some code to detect the length and save a number of spaces in a variable and then add it on.
But I was just wondering if there is another more simple way.
There's no mention how exactly the strings are taken so I'll leave this to you.
Here's how you can set spaces between two variables and the result will have fixed length.
#echo off
rem http://ss64.org/viewtopic.php?id=424
set max_len=25
set "var11=thing1"
set "var12=thing2"
set "var21=thing1xxxxxx"
set "var22=thing2"
set "var31=thing1xxxxxx"
set "var32=thing2"
call :setSpaces var11 var12
call :setSpaces var21 var22
call :setSpaces var31 var32
goto :eof
:setSpaces var1 var2 [RtnVar]
setlocal EnableDelayedExpansion
set "var1=!%~1!"
set "var2=!%~2!"
call :strlen0 var1 len1
call :strlen0 var2 len2
set /a needed_spaces=%max_len%-%len1%-%len2%
rem echo %needed_spaces%
set "spaces="
for /l %%a in (1;1;%needed_spaces%) do (
set "spaces=!spaces! "
)
set line=%var1%%spaces%%var2%
endlocal&if "%~3" neq "" (set %~3=%line%) else echo %line%
exit /b 0
:strlen0 StrVar [RtnVar]
setlocal EnableDelayedExpansion
set "s=#!%~1!"
set "len=0"
for %%N in (4096 2048 1024 512 256 128 64 32 16 8 4 2 1) do (
if "!s:~%%N,1!" neq "" (
set /a "len+=%%N"
set "s=!s:~%%N!"
)
)
endlocal&if "%~2" neq "" (set %~2=%len%) else echo %len%
exit /b
Related
I am needing help on adding to a macro that I found online that automates the process of generating PDFs from a mail merge. The current macro takes a mail merge and automatically generates individual PDFs as a result from the mail merge. See below:
Sub MailMergeToPdfBasic() ' Mark the start of the Subroutine (i.e. Macro) and name it "MailMergeToPdf"
' Macro created by Imnoss Ltd
' Please share freely while retaining attribution
' Last Updated 2021-05-03
Dim masterDoc As Document, singleDoc As Document, lastRecordNum As Long ' Create variables ("Post-it Notes") for later use
Set masterDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc when Macro run) as "masterDoc"
masterDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord ' jump to the last active record (active = ticked in edit recipients)
lastRecordNum = masterDoc.MailMerge.DataSource.ActiveRecord ' retrieve the record number of the last active record so we know when to stop
masterDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord ' jump to the first active record (active = ticked in edit recipients)
Do While lastRecordNum > 0 ' create a loop, lastRecordNum is used to end the loop by setting to zero (see below)
masterDoc.MailMerge.Destination = wdSendToNewDocument ' Identify that we are creating a word docx (and no e.g. an email)
masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' Limit the selection to just one document by setting the start ...
masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord ' ... and end points to the active record
masterDoc.MailMerge.Execute False ' run the MailMerge based on the above settings (i.e. for one record)
Set singleDoc = ActiveDocument ' Identify the ActiveDocument (foremost doc after running the MailMerge) as "singleDoc"
singleDoc.SaveAs2 _
FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
FileFormat:=wdFormatXMLDocument ' Save "singleDoc" as a word docx with the details provided in the DocFolderPath and DocFileName fields in the MailMerge data
singleDoc.ExportAsFixedFormat _
OutputFileName:=masterDoc.MailMerge.DataSource.DataFields("PdfFolderPath").Value & Application.PathSeparator & _
masterDoc.MailMerge.DataSource.DataFields("PdfFileName").Value & ".pdf", _
ExportFormat:=wdExportFormatPDF ' Export "singleDoc" as a PDF with the details provided in the PdfFolderPath and PdfFileName fields in the MailMerge data
singleDoc.Close False ' Close "singleDoc", the variable "singleDoc" can now be used for the next record when created
If masterDoc.MailMerge.DataSource.ActiveRecord >= lastRecordNum Then ' test if we have just created a document for the last record
lastRecordNum = 0 ' if so we set lastRecordNum to zero to indicate that the loop should end
Else
masterDoc.MailMerge.DataSource.ActiveRecord = wdNextRecord ' otherwise go to the next active record
End If
Loop ' loop back to the Do start
End Sub ' Mark the end of the Subroutine
In my Word doc, I have line items where the value may be 0 or blank. Each line item is on a separate line. Example:
Value A: 1234
Value B: 0
Value C: 2
Value D:
Is there a way to automate the removal of the line item if the value of the mail merge field is 0 or blank. Ideal outcome would be:
Value A: 1234
Value C: 2
If it helps narrow down the problem, I am able to replace the 0 and blank with the word "NULL" in my Excel spreadsheet:
Value A: 1234
Value B: NULL
Value C: 2
Value D: NULL
But I would still want the same outcome as above:
Value A: 1234
Value C: 2
I've Googled various combinations of "word macro delete line" but am not really understanding what I am reading online and how I can modify the code above to account for the deletion prior to the PDF generation. Any help would be appreciated.
You don't need any VBA for this - it can all be handled in the mailmerge itself via field coding.
For example, for Value_A:
{IF{MERGEFIELD Value_A \# 0}<> 0 "Value A: {MERGEFIELD Value_A}¶
"}
and, for all the values:
{IF{MERGEFIELD Value_A \# 0}<> 0 "Value A: {MERGEFIELD Value_A}¶
"}{IF{MERGEFIELD Value_B \# 0}<> 0 "Value B: {MERGEFIELD Value_B}¶
"}{IF{MERGEFIELD Value_C \# 0}<> 0 "Value C: {MERGEFIELD Value_C}¶
"}{IF{MERGEFIELD Value_D \# 0}<> 0 "Value D: {MERGEFIELD Value_D}¶
"}
If the fields are always empty when not containing data to be output, you could reduce the field coding to:
{MERGEFIELD Value_A \b "Value A: " \f "¶
"}{MERGEFIELD Value_B \b "Value B: " \f "¶
"}{MERGEFIELD Value_C \b "Value C: " \f "¶
"}{MERGEFIELD Value_D \b "Value D: " \f "¶
"}
Note: The field brace pairs (i.e. '{ }') for the above example are all created in the document itself, via Ctrl-F9 (Cmd-F9 on a Mac or, if you’re using a laptop, you might need to use Ctrl-Fn-F9); you can't simply type them or copy & paste them from this message. Nor is it practical to add them via any of the standard Word dialogues. The spaces represented in the field constructions are all required. Instead of the ¶ symbols, you should use real line/paragraph breaks.
I have a text document in Word with several parts, I have created my table of contents. I created a TOC to be able to update it automatically, it is used for that.
By alt+F9 I have TOC \O "1-2" \H \U
You can see the sign \H that I need to have the links to the headers.
I can in the headers apply the desired color before and after the two points of my titles which are the form :
[xxxxx xxxx xxxx : (red)] [yyyyy yyyyy yyyyy (black)]
I want this color difference to show up in my summary (TOC) as well. So I add the instruction \* MERGEFORMAT
This gives : TOC \O "1-2" \* MERGEFORMAT \H \U
However, by doing this, I lose my links, as the instruction \H is no longer valid.
So I switched to VBA code.
But I don't know how to say :
xxxxxxx (in red) : xxxxxx (in black)
The x is variable, and the two points ( : ) is always present in my titles in the headers.
What would be the code to say that from the 2 points ( : ) the rest of the titles must be in black color. OR that before the 2 points ( : ) the color of the titles must be in red ?
For example:
Example/title: (in red) Here is my title (in black)
Example title two: (in red) Here is my second example (in black)
Other/example/additional: (in red) This is the last title (in black)
Thank you for your insights
EDIT :
Hi,
`Dim I As Integer, J As Integer
Dim MonTableau As Variant
Dim ListePositionsMots As String
Dim MonRange As Range
With ActiveDocument
If .TablesOfContents.Count = 0 Then
MsgBox "Aucune table des matières dans le document !", vbInformation
Exit Sub
End If
With .TablesOfContents(1)
J = 1
For I = 1 To .Range.Words.Count
If J <= 2 Then
If .Range.Words(I) <> "" Then ListePositionsMots = ListePositionsMots & I & ","
J = J + 1
End If
If .Range.Words(I) = Chr(13) Then J = 1
Next I
ListePositionsMots = Mid(ListePositionsMots, 1, Len(ListePositionsMots) - 1)
MonTableau = Split(ListePositionsMots, ",")
For I = LBound(MonTableau) To UBound(MonTableau)
Set MonRange = ActiveDocument.TablesOfContents(1).Range
MonRange.SetRange Start:=MonRange.Words(MonTableau(I)).Start, End:=MonRange.Words(MonTableau(I)).End
With MonRange
If .Text <> Chr(9) Then
.Font.ColorIndex = wdRed
.Case = wdUpperCase
End If
End With
Set MonRange = Nothing
Next I
End With
End With`
Good evening,
The above code works very well and allows me to colour the first 2 words of each of my titles in my table of contents.
x y (red) : x y z (black)
v w (red) : y z (black)
So it's possible.
As sometimes my titles exceed 2 words, I have to modify it.
I have to put the value of the word ; in this case the 2 points caracters ( : ) and not its position.
x y z (red) : (red or black) x y z (black)
But I don't know what vba code can do that, that's why I'm asking on this forum, I'm sure someone can help me?
Thanks.
EDIT 2 (26/05/2021 10:45) : I repeat, I just need the VBA code, nothing more, nothing less... Thanks.
You don't need any code for this. Without the \H switch, a Table of Contents will automatically reproduce any font colouring you apply to a Heading. At most, all you need to do is to refresh the Table of Contents.
Even without the \H switch, your Table of Contents will link to the referenced content via the page #s. All the \H switch does is enable the linking from the Table of Contents text.
In any event, it would be a waste of time trying to apply colouring to the Table of Contents with VBA (or manually), since anything that causes the Table of Contents to refresh (e.g. a print preview or printing the document) will erase all that colouring.
In any event, you don't even need a macro to colour the Table of Contents as you describe - all you need is a single wildcard Find/Replace operation on the Table of Contents, where:
Find = [!^t^13]#:
Replace = ^&
and you set the replacement colour to red. You could, of course, implement that as a macro, but I can't see why anyone would bother...
The code below will apply the color you require. To capitalise the TOC you should modify the font for your TOC styles to AllCaps
Sub ColorTOC()
Dim tocRange As Range
With ActiveDocument
If .TablesOfContents.Count = 0 Then
MsgBox "Aucune table des matières dans le document !", vbInformation
Else
With .TablesOfContents(1)
Set tocRange = .Range.Duplicate
tocRange.Collapse wdCollapseStart
Do Until tocRange.End = .Range.End
tocRange.MoveEndUntil ":"
tocRange.MoveEnd wdCharacter, 1
With tocRange
If .Text <> Chr(9) Then
.Font.ColorIndex = wdRed
End If
End With
tocRange.Collapse wdCollapseEnd
tocRange.MoveUntil vbCr
tocRange.Move wdCharacter, 1
Loop
End With
End If
End With
End Sub
When a TOC is updated the dialog below is displayed.
Choosing the first option will not cause the formatting to be lost, but the TOC will not include any newly added headings. The second option will include any newly added headings, but it will also remove the formatting.
If the document has the "Update fields before printing" option set (it should to ensure that page numbers etc. are correct) then the user will be prompted to update the TOC. This will occur both prior to printing and exporting as PDF. To ensure that your TOC has the correct formatting you will need to write code to respond to the DocumentBeforePrint event so that you can reapply the formatting.
I have a simple login script that I use to map drives for users
On Error Resume Next
Set objNetwork = CreateObject("Wscript.Network")
Set colDrives = objNetwork.EnumNetworkDrives
For i = 0 to colDrives.Count-1 Step 2
objNetwork.RemoveNetworkDrive colDrives.Item(i)
Next
Dim Network
Set Network = CreateObject("Wscript.network")
Network.MapNetworkDrive "P:","\\server-A\share name A"
Network.MapNetworkDrive "N:","\\server-A\share name B"
Network.MapNetworkDrive "S:","\\server-A\share name C"
Network.MapNetworkDrive "L:","\\server-B\share name A"
Network.MapNetworkDrive "T:","\\server-C\share name"
Network.MapNetworkDrive "V:","\\server-B\share name B"
Network.MapNetworkDrive "W:","\\server-D\share name"
I would like to put the
"\\server-A\share name A"
"\\server-A\share name B"
"\\server-A\share name C"
"\\server-B\share name A"
"\\server-C\share name"
"\\server-B\share name B"
"\\server-D\share name"
In a text file and have my script read it and insert it into the script. Can anyone help with how to do this?
Consider this code:
On Error Resume Next
Const SharesFile = "C:\Test\shares.txt"
Set objNetwork = CreateObject("WScript.Network")
Set colDrives = objNetwork.EnumNetworkDrives
For i = 0 to colDrives.Count -1 Step 2
objNetwork.RemoveNetworkDrive colDrives.Item(i)
Next
Set objTxtStream = CreateObject("Scripting.FileSystemObject").OpenTextFile(SharesFile, 1, False, -2) ' charset: -2 = System default, -1 = Unicode, 0 = ASCII
For Each strLetter In Array("P:", "N:", "S:", "L:", "T:", "V:", "W:")
If objTxtStream.AtEndOfStream Then Exit For
objNetwork.MapNetworkDrive strLetter, objTxtStream.ReadLine
Next
The shares.txt text file content should be without quotes:
\\server-A\share name A
\\server-A\share name B
\\server-A\share name C
\\server-B\share name A
\\server-C\share name
\\server-B\share name B
\\server-D\share name
I'm trying to built a simple dungeon crawler game with batch script, but I keep coming across the error as I'm creating the menu screen. Could anyone please help to point out what I'm going wrong? FIXED cheers guys :)
#echo off
cls
echo LOADING GAME
ping localhost -n 2 >nul
#echo off
color 8a
title Josh's Game Beta
:loop
:menu
cls
echo You get to...
echo.
echo 1) Start
echo.
echo 2) Info
echo.
echo 3) Exit
set /p number =
if not defined number (
cls
goto loop
)
if %number% == 1 goto game
if %number% == 2 goto info
if %number% == 3 exit
:game
cls
echo Who are you?
set /p name =
echo Hello, %name%
echo Do you want to start the game(Y/N)
set /p start =
if %start% == Y goto lvl1
if %start% == y goto lvl1
if %start% == N goto menu
if %start% == n goto menu
if not defined start (
cls
goto menu
)
I haven't looked for other problems, but the following statement is creating a variable named "number " (with a space at the end):
set /p number =
The correct syntax would be
set /p "number="
I need 2 macros that will help me to finish my work faster:
one to delete all the images from the document (no matter the place).
a second one that will create a table and insert the data under it automatically. (I have to combine in word thousands of doc files and create this table at the top of every inserted file). Can this be done?
Ex.
"R O M Â N I A
ÎNALTA CURTE DE CASAŢIE ŞI JUSTIŢIE
SECŢIA CIVILĂ ŞI DE PROPRIETATE INTELECTUALĂ **(this is aligned at left or centered, and always has 2 enters after it for inserting the table, only this line may be different but the first to are always the same)**
Decizia nr. **2570** Dosar nr. **9304/1/2009**
Şedinţa publică ..."
all the files begin with this text, only what is with asterix is different"
and i have to create a table for the row with "Decizie", "Dosar" and numbers
something like this:
"R O M Â N I A
ÎNALTA CURTE DE CASAŢIE ŞI JUSTIŢIE
SECŢIA CIVILĂ ŞI DE PROPRIETATE INTELECTUALĂ
|Decizia nr. *2570/**2009*** | Dosar nr. *9304/1/2009*| - a table without borders, first column aligned left, second one right, at the first column also added the date from the second one
Şedinţa publică ..."
Can somebody help me with a macro that will create this table automatically?
It is not really clear what do you mean by combining and what exactly should be in the table. If you want to have the content of many docs in one, "combined" doc file, then here's a quick and dirty solution to the second macro:
Please note that under Tools / References in VBA editor you have to check "Microsoft Scripting Runtime" under available libraries.
Dim fs As New FileSystemObject
Dim fo As Folder
Dim fi As File
Sub processDocFiles()
Dim doc As Document
Dim thisdoc As Document
Set thisdoc = ActiveDocument
' set the directory
Set fo = fs.GetFolder("C:\Temp\doc")
' iterate through the files
For Each fi In fo.Files
' check the files
If (fi.Name <> ActiveDocument.Name) And (Left(fi.Name, 1) <> "~") And (Right(fi.Name, 5) = ".docx") Then
Debug.Print "Processing " & fi.Name
Set doc = Application.Documents.Open(fi.Path)
' doc.Content.InsertAfter (fi.Path)
thisdoc.Content.InsertAfter (doc.Content)
thisdoc.Content.InsertAfter ("--------------------------------------------------" & Chr(13) & Chr(10))
doc.Close
End If
Next
End Sub
This copies the contents of all the doc files in a folder into one single document.
And the other one is:
Sub delImages()
Dim doc As Document
Dim thisdoc As Document
Set thisdoc = ActiveDocument
' set the directory
Set fo = fs.GetFolder("C:\Temp\doc")
' iterate through the files
For Each fi In fo.Files
' check the files
If (fi.Name <> ActiveDocument.Name) And (Left(fi.Name, 1) <> "~") And (Right(fi.Name, 5) = ".docx") Then
Debug.Print "Processing " & fi.Name
Set doc = Application.Documents.Open(fi.Path)
For Each pic In doc.InlineShapes
pic.Delete
Next
doc.Save
doc.Close
End If
Next
End Sub