Automated formatting

[nsajeff]

Hi, Im wondering if there is a way to automate the formatting of multiple workbooks across mutliple spreadsheets. I have Workbooks that each contain 20-30 worksheets.

Each of these worksheets has fields that I need formatted the same(Font size 14, unbold(if text is bolded) and if text is too large to view on size 14, automatically reduce to appropriate font size. Is this possible?

The fields would be A7, D7, A8, G8, C11, E11, F11.

As I said, I have several workbooks all in the same folder. I dont mind opening them individually to apply the code but if it could open any workbook in a folder, that would be incredible too.

Either way, if someone could help, I would be incredibly greatful. Thanks!

Jeff

[mdmackillop]

What does this mean? - if text is too large to view

[nsajeff]

Sorry, what I meant was, if font size 14 caused the text to exceed that field, I want it to use a smaller size until the text fits inside that field without exceeding it.

Thanks!

What does this mean? - if text is too large to view

Edit: There are 24 workbooks. As I mentioned, there are anywhere from 10-80 worksheets in each of these workbooks. Figured more info might help.

[mdmackillop]

Can you post a sample worksheet so we can see column widths, (I assume these will be constant across sheets) also sample text so we can see what typically goes into these cells.

[mbarron]

The following will ask for the directory where the files are located - you can pick any file from the directory, it will alter all XLS files.

It will then scan each worksheet in each workbook and set the font type of the cells in your range to Normal (no bold, no italics). It will also set the Shrink to Fit property for the cells to True. Lastly it will save each of the files.

[vba]Sub importDirect()
Application.ScreenUpdating = False
Dim wbkTo As Workbook 'current book
Dim wsTo As Worksheet 'dest sheet in current book
Dim wbFr As Workbook 'wb from directory
Dim wsFr As Worksheet
Dim strPath As String 'location directory of files
Dim strFile As String 'file name
Dim i As Long
Dim strDirect As String


'x-x-x-x gets the directory for import x-x-x-x
Dim wrkCur As Workbook
Set wrkCur = ActiveWorkbook
Application.Dialogs(xlDialogOpen).Show
If wrkCur.Name = ActiveWorkbook.Name Then
MsgBox "You canceled the operation", vbExclamation
Exit Sub
End If
strPath = ActiveWorkbook.Path & "\"
ActiveWorkbook.Close savechanges:=False
strFile = Dir(strPath & "*.xls")
Set wsTo = ActiveSheet

Do While Not strFile = ""
strFile = Dir
Loop


strFile = Dir(strPath & "*.xls")

Do While Not strFile = ""

'x-x-x-x-x-x Do stuff with the workbooks x-x-x-x-x-x-x-x
Set wbFr = Workbooks.Open(strPath & strFile)

'x-x-x-x-x-x test stuff x-x-x-x-x-x-x-x
For i = 1 To wbFr.Worksheets.Count
Set wsFr = wbFr.Sheets(i)
With wsFr.Range("A7, D7, A8, G8, C11, E11, F11")
.ShrinkToFit = True
With .Font
.FontStyle = "Normal"
.Size = 14
End With
End With
Next
Application.DisplayAlerts = False
wbFr.Close savechanges:=True
Application.DisplayAlerts = True
strFile = Dir
Loop
Application.ScreenUpdating = True

End Sub[/vba]