View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Patrick Molloy[_9_] Patrick Molloy[_9_] is offline
external usenet poster
 
Posts: 15
Default visual basic macro in excel

I see you've had replies...This one gives you the menu
items set as you requested:

Sub AddMenu()

Dim ctrlMain As CommandBarPopup
Dim ctrlItem As CommandBarControl
Dim ctrlSubItem As CommandBarButton

KillMenu

Set ctrlMain = _
CommandBars("Worksheet Menu Bar").Controls.Add _
(Type:=msoControlPopup, _
temporary:=True)

With ctrlMain
.Caption = "&Analysis"

Set ctrlItem = _
.Controls.Add(Type:=msoControlButton)
With ctrlItem
.Caption = "&Initialse Test"
.OnAction = "subInitialise"
End With
Set ctrlItem = _
.Controls.Add(Type:=msoControlPopup)
With ctrlItem

.Caption = "&Explore Test"
.BeginGroup = True

Set ctrlSubItem = _
.Controls.Add(Type:=msoControlButton)
With ctrlSubItem
.Caption = "Type &1"
.OnAction = "sub1"
End With
Set ctrlSubItem = _
.Controls.Add(Type:=msoControlButton)
With ctrlSubItem
.Caption = "Type &2"
.OnAction = "Sub2"
End With
End With
Set ctrlItem = .Controls.Add
(Type:=msoControlButton)
With ctrlItem
.Caption = "&Plan Test"
.BeginGroup = True
.OnAction = "sub3"
End With
End With
End Sub
Sub KillMenu()
Dim cmdbar As CommandBar
On Error Resume Next
Set cmdbar = CommandBars("Worksheet Menu Bar")
cmdbar.Controls("&Analysis").Delete
On Error GoTo 0
End Sub



Patrick Molloy
Microsoft Excel MVP

-----Original Message-----
file: testsource.exl
date lpc-b
1/1/1992 5
1/2/1992 0
1/3/1992 1
1/4/1992 4

file:testresult.exl
date
11/29/1991
12/24/1992
1/1/1992
1/2/1992
1/3/1992
1/4/1992
1/5/1992
1/6/1992

I am trying to use the lpc-b dat in testsource.exl to

expand the date column
in testresult.excel, inserting blank columns and then

filling down so the
number of date entries equals the lpc-b value. final

spreadsheet should look
like this:

file:testresult.exl
date
11/29/1991
12/24/1992
1/1/1992
1/1/1992
1/1/1992
1/1/1992
1/1/1992
1/3/1992
1/4/1992
1/4/1992
1/4/1992
1/4/1992
1/5/1992
1/6/1992

I found that when I record a macro, the operations of

moving one column down
and dragging down to select a range of cells don't seem

to be recognized
and, indeed, when I try to modify the macro to do this I

get error messages
about procedures not being supported. Is it possible to

fix the following
code, or is it not possible to do using variable names.

Commented code
follows:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 7/22/03 by Thomas L. Wright
'

'

Workbooks.Open FileName:= _
"Macintosh HD:TLW/RSF kilauea
book:tilt/seismicity:tilt/seismicity.excel:eq

count/tremor:testsource.exl"
Workbooks.Open FileName:= _
"Macintosh HD:TLW/RSF kilauea
book:tilt/seismicity:tilt/seismicity.excel:eq

count/tremor:testresult.exl"
Windows("testsource.exl").Activate
Range("d2").Select
Selection.Copy
eqctnum = Selection
Range("A2").Select
Selection.Copy
sourcedate = Selection
Windows("testresult.exl").Activate
Columns("A:A").Select
Selection.Find(What:=sourcedate, After:=ActiveCell,

LookIn:=xlFormulas,
LookAt:=xlPart, SearchOrder:=xlByRows,

SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Select
Code works to here, including use of

variable for date
now when I try to move down one

cell, select that cell
and the three below it, no command, wuch as cell.offset,

seems to work
Selection.Insert

Shift:=xlDown This line works
Windows("testsource.exl").Activate

The rest of the code uses explicit

ranges, which I
cannot specify without using the variable "eqctnum".

Range("A3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("testresult.exl").Activate
Columns("A:A").Select
Selection.Find(What:="1/2/1992", After:=ActiveCell,

LookIn:=xlFormulas,
_
LookAt:=xlPart, SearchOrder:=xlByRows,

SearchDirection:=xlNext, _
MatchCase:=False).Activate
Application.CutCopyMode = False
Range("A9").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Windows("testsource.exl").Activate
Range("A5").Select
Windows("testresult.exl").Activate
Columns("A:A").Select
Selection.Find(What:="1/4/1992", After:=ActiveCell,

LookIn:=xlFormulas,
_
LookAt:=xlPart, SearchOrder:=xlByRows,

SearchDirection:=xlNext, _
MatchCase:=False).Activate
Range("A11:A13").Select
Selection.Insert Shift:=xlDown
Range("A10:A13").Select
Selection.FillDown
Range("B9").Select
ActiveWorkbook.Save
ActiveWindow.Close
Range("B4").Select
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

.