PDA

View Full Version : [SOLVED:] AUTO HIDE TABLES BASED ON CONTENT



PeterKom
04-25-2020, 01:19 PM
Hello,

I have nearly finished an Excel tool for inserting new offers and configuring our product.
The whole configuration is stored in a table on a worksheet in a single row. Each data has its own tag.
In word I have a template with those same tags like <<data>>. When pressing a button in Excel the VBA script
opens the chosen Word template and replaces all the tags with the actual data. This data is normaly in
tables in the Word template.
So far It works fine.

Becasue sometimes the offer includes several simmilar products I have made it possbile that in Excel for each offer 4 positions for 4 different products can be done.
Of course it can be just 1 or 2 but 4 is max.
So I made 4 configuration Tables in the Word template. The first table will have all the tags with ending on 1 the second table all the tags ending on 2 and so on.

If not all 4 tables are in use how to make the remaining tabels which were not filled with the actual data to HIDE?

The excel VBA script takes about 10-15 sec. to fill in all the data in the 4 tables in Word template. After that the tables which are remaining with just the tags should be hidden.

Any way to do this?

I have found out that you can hide tabel with Active X check boxes or input fields but this is not automatic and the check box remains visible.
I don't want this. The proces should be automatical.

The Excel script actualy closes the Word document in the end and also makes a PDF our of it. OK we can make it not to close the document if needed i assume via the VBA in Excel.

I'm realy stuck with this final part.
Any help would be appreciated.

Please find attached an example of the Word template.

BR
Peter

macropod
04-25-2020, 03:29 PM
Kindly post the code you're using.

PeterKom
04-25-2020, 11:55 PM
Hello,

In Word there is no code so far.

The code in Excel that brings the data from the one table where it is collected to Word and into PDF is the following.
It is put together from various sources so it is not perfect and also not finished yet. I have to configure the PDF part yet so the PDF is made on fly together with the word document.



Sub CreateWordDocuments()
Dim CustRow, CustCol, LastRow, TemplRow, DaysSince, FrDays, ToDays As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim CurDt, LastAppDt As Date
Dim WordDoc, WordApp, OutApp, OutMail As Object
Dim VarFormat As String
Dim VarValue As String
Dim WordContent As Word.Range
Dim date_example As String
date_example = Now()
With Sheet1

If .Range("B3").Value = Empty Then
MsgBox "Prosim izberi pravo podlogo iz seznama podlog"
.Range("H3").Select
Exit Sub
End If
TemplRow = .Range("B3").Value 'Set Template Row
TemplName = .Range("H3").Value 'Set Template Name
FrDays = .Range("M3").Value 'Set From Days
ToDays = .Range("O3").Value 'Set To Days
DocLoc = Sheet2.Range("F" & TemplRow).Value 'Word Document Filename

'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If


LastRow = .Range("E9999").End(xlUp).Row 'Determine Last Row in Table
For CustRow = 8 To LastRow
DaysSince = .Range("N" & CustRow).Value
If .Range("O" & CustRow).Value = "" And DaysSince >= FrDays And DaysSince <= ToDays Then
Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 4 To 200 'Move Through Columns
If .Cells(4, CustCol).Value = "Splosno" Then VarFormat = "General" Else: VarFormat = .Cells(5, CustCol).Value 'Determine Variable Format
TagName = .Cells(7, CustCol).Value 'Tag Name
TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = Application.WorksheetFunction.Text(TagValue, VarFormat)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll 'Find & Replace all instances
End With
Next CustCol

If .Range("J3").Value = "PDF" Then
FileName = ThisWorkbook.Path & "\" & .Range("E" & CustRow).Value & "_" & .Range("F" & CustRow).Value & ".pdf" 'Create full filename & Path with current workbook location, Last Name & First Name
WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF
WordDoc.Close False
Else: 'If Word
FileName = ThisWorkbook.Path & "\" & .Range("H" & CustRow).Value & " " & .Range("D" & CustRow).Value & "-" & .Range("U" & CustRow).Value & "-" & .Range("R" & CustRow).Value & ".docx"
WordDoc.SaveAs FileName
End If
.Range("O" & CustRow).Value = "DA" 'pre je bilo to' TemplName 'Template Name
.Range("P" & CustRow).Value = Format(date_example, "dd.mm.yyyy hh:nn")
.Range("R" & CustRow) = Format(date_example, "yyyy")
If .Range("Q3").Value = "Email" Then
Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
Set OutMail = OutApp.CreateItem(0) 'Create Email
With OutMail
.To = Sheet1.Range("L" & CustRow).Value
.Subject = "Hi, " & Sheet1.Range("F" & CustRow).Value & " We Miss You"
.Body = "Hello, " & Sheet1.Range("F" & CustRow).Value & " Its been a while since we have seen you so we wanted to send you a special letter. Please see the attached file"
.Attachments.Add FileName
.Display 'To send without Displaying change .Display to .Send
End With
Else: 'Print Out
WordDoc.PrintOut
WordDoc.Close
End If
Kill (FileName) 'Deletes the PDF or Word that was just created
End If '3 condition met
Next CustRow
WordApp.Quit
End With
End Sub



BR

macropod
04-26-2020, 04:35 AM
Given that your attached document implies the existence of content associated with each table beyond the tables themselves, the simplest approach would be to bookmark the range applicable to each table (e.g. Pozicija_1, Pozicija_2, Pozicija_3, Pozicija_4). Then, if a given table isn't used, simply delete the bookmarked content. That could be done using code like:

Dim Tbl As Long, Rw As Long, StrData As String
With WordDoc
For Tbl = 4 To 2 Step -1
With .Tables(Tbl)
StrData = ""
For Rw = 3 To 14
StrData = StrData & Split(.Cell(Rw, 2).Range.Text, vbCr)(0)
Next
If StrData = "" Then .Range.Bookmarks(1).Range.Delete
End With
Next
End With
inserted after:
Next CustCol

Note: The above code assumes your 'Pozicija 1' table is the first in the document and that the 'Pozicija 1' to 'Pozicija 4' tables have no other tables between them. The code also assumes that unused tables will be empty in all of rows 3 through 14 in column 2.

PeterKom
04-26-2020, 04:56 AM
Thanks I will give it a try.

Please find attached the Excel sheet with the used tabel and the Word Template.
Copy them in the same folder and run the Excel. With the GREEN button you lunch the code that fills in the Word template.
After it will finish it closes automaticaly. The saved Word file should be in the same folder.
To test the script again just delete the value in column O and P which are put in by the script to know the offer has ben made.

BR
Peter

PeterKom
04-26-2020, 05:28 AM
Hi, I have bookmarked the tables as suggested and the script does indeed delete the data in the table but not the table it self.
The idea was to delete the whole thing so the data that follows moves up.

PeterKom
04-26-2020, 06:19 AM
I have modified the last bit of your code so it does delete the whole table liek that:


If StrData = "" Then .Range.Bookmarks(1).Range.Tables(1).Delete

Is there any way to move up the text that is after the deleted tables right behind (2 empy rows) the last table that is in filled with data.
I assume I have also to bookmark this bits of text.

macropod
04-26-2020, 04:00 PM
Is there any way to move up the text that is after the deleted tables right behind (2 empy rows) the last table that is in filled with data.
I assume I have also to bookmark this bits of text.
As I said in my previous reply:

bookmark the range applicable to each table
I did not say to bookmark only the table.

PeterKom
04-27-2020, 01:27 AM
Great, I did it by increasing the table by so much but if the bookmark can be the tabel + empty space after it or above it even better. I will try it.

Thank you very much for you fast reply and help in this matter!

Peter

PeterKom
04-27-2020, 02:32 PM
Dear Paul, I have tried to include the empty spaces before and after the table to the Bookmarks but they are not deleted by this line of code

If StrData = "" Then .Range.Bookmarks(1).Range.Tables(1).Delete

Peter

macropod
04-27-2020, 02:48 PM
Without wanting to place too fine a point on it, that is not the code I posted...

PeterKom
04-27-2020, 10:20 PM
Hehe, sorry you are right the bit of change I did to th code did delete the acctual table when it was selected but yours did not. Deleted only the data in it.
But when selecting the empty space before and after the table your code works as I wanted.
Thanks a lot! :clap::clap:
Peter