Pages

Showing posts with label Excel. Show all posts
Showing posts with label Excel. Show all posts

Monday, February 24, 2014

Macro to unprotect excel sheet

sub MyMacro()
                        Dim i As Integer, j As Integer, k As Integer
                Dim l As Integer, m As Integer, n As Integer
                Dim i1 As Integer, i2 As Integer, i3 As Integer
               Dim i4 As Integer, i5 As Integer, i6 As Integer
               On Error Resume Next
                For i = 65 To 66 : For j = 65 To 66 : For k = 65 To 66
             For l = 65 To 66 : For m = 65 To 66 : For i1 = 65 To 66
             For i2 = 65 To 66 : For i3 = 65 To 66 : For i4 = 65 To 66
             For i5 = 65 To 66 : For i6 = 65 To 66 : For n = 32 To 126
             ActiveSheet.Unprotect(Chr(i) & Chr(j) & Chr(k) & _
                Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
                 Chr(i4) & Chr(i5) & Chr(i6) & Chr(n))
             If ActiveSheet.ProtectContents = False Then
                Exit Sub
             End If
                                Next : Next : Next : Next : Next : Next
                                 Next : Next : Next : Next : Next : Next
                end sub


----------------------

Private Sub UnprotectSheet()
        'Breaks worksheet password protection.

        Dim strPassword As String = Configuration.ConfigurationManager.AppSettings("ProtectPassword").ToString()
        Dim intCtr As Integer = 0
        Dim ObjExcel As New Excel.Application
        Dim objWbook As Excel.Workbook
        For intCtr = 0 To lstFiles.Items.Count - 1
            ObjExcel.Workbooks.Add(txtInputFolder.Text & "\" & lstFiles.Items(intCtr))
        Next
        Dim wsHeet As Excel.Worksheet

        ObjExcel.DisplayAlerts = False
        intCtr = 0
        For Each objWbook In ObjExcel.Workbooks
            Dim xlmodule As Object 'VBComponent
            xlmodule = objWbook.VBProject.VBComponents.Add(1) 'vbext_ct_StdModule

            Dim strCode As String
            strCode = _
               "sub MyMacro()" & vbCr & _
               "         Dim i As Integer, j As Integer, k As Integer " & vbNewLine & _
               " Dim l As Integer, m As Integer, n As Integer " & vbNewLine & _
                "Dim i1 As Integer, i2 As Integer, i3 As Integer " & vbNewLine & _
              " Dim i4 As Integer, i5 As Integer, i6 As Integer " & vbNewLine & _
              " On Error Resume Next " & vbNewLine & _
                "For i = 65 To 66 : For j = 65 To 66 : For k = 65 To 66 " & vbNewLine & _
            " For l = 65 To 66 : For m = 65 To 66 : For i1 = 65 To 66 " & vbNewLine & _
            " For i2 = 65 To 66 : For i3 = 65 To 66 : For i4 = 65 To 66 " & vbNewLine & _
            " For i5 = 65 To 66 : For i6 = 65 To 66 : For n = 32 To 126 " & vbNewLine & _
            " ActiveSheet.Unprotect(Chr(i) & Chr(j) & Chr(k) & _" & vbNewLine & _
            "    Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ " & vbNewLine & _
                " Chr(i4) & Chr(i5) & Chr(i6) & Chr(n))" & vbNewLine & _
            " If ActiveSheet.ProtectContents = False Then " & vbNewLine & _
            "    Exit Sub " & vbNewLine & _
            " End If " & vbNewLine & _
                          "      Next : Next : Next : Next : Next : Next " & vbNewLine & _
                                " Next : Next : Next : Next : Next : Next " & vbNewLine & _
                "end sub"


            strCode = _
               "sub MyMacro()" & vbCr & _
               " If ActiveSheet.ProtectContents = true Then" & vbNewLine & _
             "   ActiveSheet.Unprotect """ & strPassword & """ " & vbNewLine & _
            " End If " & vbNewLine & _
             "end sub"


            xlmodule.CodeModule.AddFromString(strCode)

            For Each wsHeet In objWbook.Worksheets
                wsHeet.Activate()
                If objWbook.ActiveSheet.ProtectContents = True Then
                    ObjExcel.Run("MyMacro")
                End If
            Next

            objWbook.Close(True, txtInputFolder.Text & "\" & lstFiles.Items(intCtr))
            intCtr = intCtr + 1


           
        Next
        ObjExcel.Quit()


    End Sub

Wednesday, October 19, 2011

Add or Remove apostrophe to cell in active excel sheet

Option Explicit
Sub DeathToApostrophe()
    Dim s As Range, temp As String
    If MsgBox("Are you sure you want to remove all leading apostrophes from the entire sheet?", _
    vbOKCancel + vbQuestion, "Remove Apostrophes") = vbCancel Then Exit Sub
    Application.ScreenUpdating = False
    For Each s In ActiveSheet.UsedRange
        If s.HasFormula = False Then
             'Gets text and rewrites to same cell without   the apostrophe.
            s.Value = s.Text
        End If
    Next s
    Application.ScreenUpdating = True
End Sub


Sub AddApostrophes()
    Dim cel As Range
    Dim strw As String
    
    strw = "You cannot undo this task."
    strw = strw & " You may want to save your work to a new file."
    strw = strw & " Press OK to proceed, Cancel to quit."
    If vbCancel = MsgBox(strw, vbOKCancel + vbCritical, "Task Cannot Be Undone") Then Exit Sub
    
    For Each cel In ActiveSheet.UsedRange
        cel.Value = "'" & cel.Value
    Next cel
End Sub


How to use
  1. Copy above code.
  2. In Excel press Alt + F11 to enter the VBE.
  3. Right-click desired file on left.
  4. Choose Insert -Module.
  5. Paste code into the right pane.
  6. Press Alt + Q to close the VBE.
  7. Save workbook before any other changes. 
Test the code
  1. Ensure Active sheet is the desired sheet.
  2. Press Alt + F8.
  3. Choose 'DeathToApostrophe'.
  4. Press 'Run'.
  5. Confirm with 'Ok' to run.