Thursday, August 4, 2011

Unprotect and Protect Sheet using VBA code

Here is a sample to unprotect a sheet and write some values and then protect the sheet again

Sub Unprotect_And_ThenProtect()

ActiveSheet.Unprotect
Range("A2").Value = Now()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

AutomaticHyphenation feature

Word does automatic hyphenation at the end of line when the AutomaticHyphenation feature is turned on


ActiveDocument.AutoHyphenation = True

You can test it by try selecting the Hyphen (which is not there physically)

The following code converts all automatic hyphens to manual ones


ActiveDocument.ConvertAutoHyphens

How to Specify the Password in SaveAs option in PowerPoint VBA

Unlike SaveAs in Word/Excel, which takes the Password as part of the argument, Powerpoint SaveAs function doesn't specify it.

Here is a way to do it through VBA


Sub Save_Presentation_With_Password()

Dim oPS As PowerPoint.Presentation
Dim sTempPath As String

Set oPS = Presentations.Add
oPS.Slides.Add 1, ppLayoutTitle

' ----------------------------
' Coded by chithu for VBACT.Blogspot.com
' ----------------------------

sTempPath = Environ("Temp") & "\"

oPS.Password = "PWD2PPT"


oPS.SaveAs FileName:=sTempPath & "PPTSample1.ppt", FileFormat:=ppSaveAsDefault
oPS.Close


End Sub

Hide / Unhide Sheet Tab using Excel VBA

If you want to hide the Sheet Tab you can do that using Excel Options

1) Uncheck the Show sheet tabs checkbox from Advanced Tab of Options Menu.
2) Go to the advanced tab and you can enable/disable through the show sheet tabs options.


You can do the same through Excel VBA

ActiveWindow.DisplayWorkbookTabs = False

HOW TO EXTRACT ALL FORMULA'S IN EXCEL SHEET USING VBA

Highlight all cells containing Formulas using Excel VBA

The following snippet highlights all cells that contain formula


Sub HighLight_Formula_Cells()

Dim oWS As Worksheet
Dim oCell As Range

Set oWS = ActiveSheet

For Each oCell In oWS.Cells.SpecialCells(xlCellTypeFormulas)
oCell.Interior.ColorIndex = 36
MsgBox oCell.Formula
Next oCell


End Sub

Wednesday, July 6, 2011

Combining Text Files using VBA

Multiple utilities are available to split & merge text files. However, here is a simple one my friend uses to merge around 30 ascii files into one

It uses File System Object and you need to add a reference of Microsoft Scripting Runtime

Sub Append_Text_Files()

Dim oFS As FileSystemObject
Dim oFS1 As FileSystemObject

Dim oTS As TextStream
Dim oTS1 As TextStream

Dim vTemp

Set oFS = New FileSystemObject
Set oFS1 = New FileSystemObject


For i1 = 1 To 30

Set oTS = oFS.OpenTextFile("c:\Sheet" & i1 & ".txt", ForReading)
vTemp = oTS.ReadAll

Set oTS1 = oFS.OpenTextFile("c:\CombinedTemp.txt", ForAppending, True)
oTS1.Write (vTemp)

Next i1

End Sub

The code is simple.. it searches for files from Sheet1.txt ...Sheet30.txt and copies the content into one variable. Then it appends the content to CombinedTemp.txt

Query Table with Excel as Data Source

Sub Excel_QueryTable()

Dim oCn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim ConnString As String
Dim SQL As String

Dim qt As QueryTable

ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\SubFile.xls;Extended Properties=Excel 8.0;Persist Security Info=False"
Set oCn = New ADODB.Connection
oCn.ConnectionString = ConnString
oCn.Open

SQL = "Select * from [Sheet1$]"

Set oRS = New ADODB.Recordset
oRS.Source = SQL
oRS.ActiveConnection = oCn
oRS.Open

Set qt = Worksheets(1).QueryTables.Add(Connection:=oRS, _
Destination:=Range("B1"))

qt.Refresh

If oRS.State <> adStateClosed Then
oRS.Close
End If


If Not oRS Is Nothing Then Set oRS = Nothing
If Not oCn Is Nothing Then Set oCn = Nothing

End Sub