Não é mais possível fazer postagens ou usar assinaturas novas da Usenet nos Grupos do Google. O conteúdo histórico continua disponível.
Dismiss

Attn Mark Samborsky

45 visualizações
Pular para a primeira mensagem não lida

Mark Samborsky

não lida,
16 de mar. de 2001, 11:58:3716/03/2001
para
Thank you for this script! Unfortunately, I get an access violation error
when it attempts to open the userform at:

>Sub CopyNonFormula()
* >UserForm1.Show *
>End Sub

Excel 97 crashes at this point. I suspect that I did not create the
userform correctly and I will try it again. Any other ideas are
appreciated.

Mark

Harald Staff wrote in message ...
>Hi folks. This is an answer, not a question. Mark emailed me for a problem,
>and his firewall won't let anything containing code pass, not even zips.
>He's in a well paid job in a well protected place I guess. So here is a
>how-to-do-it for Mark and everyone else.
>
>How to do what ? Mark wants to select which sheets from the active workbook
>that should be copied into a fresh new workbook, and in there which sheets
>that should have their formulas removed and replaced with the cell values.
>It's a very useful add-in, so help yourselves.
>
>Best wishes Harald
>
>Here we go:
>
>Step 1:
>********************
>Open Visual Basic Editor (Alt F11 or whatever).
>
>Create a userform.
>Set its caption to "Copy Creator"
>
>Add a label -name Label1
>Add a listbox -name ListBox1
>
>Add two commandbuttons -name CommandButton1 and CommandButton2.
>CommandButton1 has caption "Work", CommandButton2 has caption "Don't Work".
>
>Step 2:
>********************
>Paste this code into the userform module:
>
>Option Explicit 'top of module
>
>Dim Status As Byte
>
>Private Sub CommandButton1_Click()
>Dim WBName As String
>WBName = ActiveWorkbook.Name
>Dim sh As Worksheet
>Select Case Status
> Case 1
> If CopySheets = False Then Exit Sub
> If WBName = ActiveWorkbook.Name Then Exit Sub
> ListBox1.Clear
> For Each sh In ActiveWorkbook.Worksheets
> ListBox1.AddItem sh.Name
> Next
> Label1.Caption = _
> "Select sheets for replacing formulas with values:"
> Status = Status + 1
> Case 2
> Application.ScreenUpdating = False
> Call ReplaceFormulas
> Application.ScreenUpdating = True
> Unload Me
> MsgBox "A copy was successfully created."
>End Select
>End Sub
>
>Private Sub CommandButton2_Click()
>Unload Me
>End Sub
>
>Private Sub UserForm_Initialize()
>Dim sh As Worksheet
>For Each sh In ActiveWorkbook.Worksheets
> ListBox1.AddItem sh.Name
>Next
>Label1.Caption = "Copy selected sheet(s) to a new workbook:"
>ListBox1.MultiSelect = fmMultiSelectMulti
>Status = 1
>End Sub
>
>Step 3:
>********************
>Add a standard module (Insert menu). Paste this code into it:
>
>Option Explicit 'top of module
>
>Sub CopyNonFormula()
>UserForm1.Show
>End Sub
>
>
>Function CopySheets() As Boolean
>Dim MySheets() As Long
>
>Dim r As Integer
>Dim x As Integer
>ReDim MySheets(0)
>x = 0
>For r = 0 To UserForm1.ListBox1.ListCount - 1
> If UserForm1.ListBox1.Selected(r) = True Then
> If x > 0 Then ReDim Preserve MySheets(x)
> MySheets(x) = r + 1
> x = x + 1
> End If
>Next
>If x = 0 Then
> MsgBox "No sheet selected"
> CopySheets = False
> Exit Function
>End If
>Sheets(MySheets).Copy
>CopySheets = True
>End Function
>
>Sub ReplaceFormulas()
>Dim MySheets() As Long
>Dim r As Integer
>Dim cel As Range
>On Error Resume Next
>For r = 0 To UserForm1.ListBox1.ListCount - 1
> If UserForm1.ListBox1.Selected(r) = True Then
> Sheets(UserForm1.ListBox1.List(r)).Select
> For Each cel In _
> Selection.SpecialCells(xlCellTypeFormulas, 23).Cells
> UserForm1.Caption = ActiveSheet.Name & cel.Address
> cel.Value = cel.Value
> Next
> End If
>Next
>End Sub
>
>Sub Auto_open()
> Dim ToolsMenu As CommandBarPopup
> Dim NewMenuItem As CommandBarButton
>
>' Delete the menu if it already exists
> Call Auto_close
>
>' Find the File Menu
> Set ToolsMenu = CommandBars(1).FindControl(ID:=30002)
> If ToolsMenu Is Nothing Then
>' MsgBox "Cannot add a menu item - use Ctrl+Shift+C."
> Exit Sub
> Else
> Set NewMenuItem = ToolsMenu.Controls.Add _
> (Type:=msoControlButton, Before:=11)
> With NewMenuItem
> .Caption = "&Non-Formula Copy"
> .FaceId = 285
> .OnAction = "CopyNonFormula"
> .BeginGroup = False
> End With
> End If
>End Sub
>
>Sub Auto_close()
> On Error Resume Next
> CommandBars(1).FindControl(ID:=30002). _
> Controls("&Non-Formula Copy").Delete
>End Sub
>
>Step 4:
>********************
>
>Go back to a worksheet. Save the file as an Excel Add-in (downmost choice
in
>filetype menu in saveas dialog). Close and reopen.
>
>Now there is a menu item in File menu that says "Non-formula copy" ready to
>run.
>
>
>
>


Harald Staff

não lida,
16 de mar. de 2001, 12:14:3616/03/2001
para
Hi Mark

If the userform has another name than UserForm1(which I should have
spesified, sorry) , then replace UserForm1 with that name in all parts of
the code where it occurs.

HTH. Best wishes Harald

Mark Samborsky <sambors...@fin.nospamm.gc.ca> wrote in message
news:OMzSEojrAHA.1912@tkmsftngp04...

Harald Staff

não lida,
16 de mar. de 2001, 04:55:4416/03/2001
para

Harald Staff

não lida,
17 de mar. de 2001, 11:23:1517/03/2001
para
fyi We still have problems that I don't understand, continuing on email. If
others have trouble with this then please let me know... I may have goofed
again...

Best wishes Harald

Harald Staff <harald...@eunet.no> wrote in message
news:uTSBxxjrAHA.1236@tkmsftngp04...

0 nova mensagem