| View previous topic :: View next topic |
| Author |
Message |
danny subliem
Guest
|
 Posted: Fri Feb 13, 2004 12:43 am Post subject: Can anyone help me to translate this into OOobasic please??? |
 |
|
Sub KolommenToevoegen()
' Macro recorded 13/11/2001 by Filip Heymans
Dim AR As Variant
Dim Bereik As Variant
TimingMacro "E24"
'bewerking sheet 'artikels'
Sheets("Artikels").Select
'creatie teller
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,R[2]C:R[49999]C)"
AR = Cells(1, 1).Value
'extra kolom 'Art-Cont'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "Art-Cont"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=RC[10]&"" - ""&TRIM(RC[9])"
Range("A3").Select
Selection.Copy
Bereik = "A4:A" & AR + 2
Range(Bereik).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:A").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2").Select
'bewerking sheet 'kostprijzen'
Sheets("Kostprijzen").Select
'creatie teller
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,R[2]C:R[65535]C)"
AR = Cells(1, 1).Value
'extra kolom 'Art-Cont'
Columns("D ").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "Art-Cont"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=RC[-2]&"" - ""&TRIM(RC[-1])"
Range("D3").Select
Selection.Copy
Bereik = "D4:D" & AR + 2
Range(Bereik).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("D").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'extra kolom 'item group'
Range("I2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "it group"
Range("I3").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],Artikels!R2C1:R15000C5,5,0)"
Range("I3").Select
Selection.Copy
Bereik = "I4:I" & AR + 2
Range(Bereik).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("I:I").Select
Selection.Copy
Range("I1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("I2").Select
TimingMacro "E26"
Beep
Beep
Beep
End Sub
'------------------------------------------------------------------------------
Sub TimingMacro(Cel)
' Macro recorded 13/11/2001 by Filip Heymans
Sheets("legende").Select
Range("E1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Range(Cel).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub |
|
| Back to top |
|
 |
Ian Laurenson
Guest
|
| Posted: Fri Feb 13, 2004 12:29 pm Post subject: Turning of autofilter and deleting columns |
|
|
This should give you the idea - Cheers Ian
| Code: |
Sub ResetSheets()
dim oDoc as object
'Macro written by Ian laurenson to demonstrate how to change the
' Macro recorded 13/11/2001 by Filip Heymans in Excel to OOo Basic
'*****************************************************
'* deze macro herstelt de originele sheet-layout *
'*****************************************************
oDoc = StarDesktop.CurrentComponent
'deleten vd kolommen 'It.Group' & 'Art-Cont'
'en de eerste rij uit de tabel met de kostprijzen
'Sheets("Kostprijzen").Select
oSheet1 = oDoc.sheets.getByname("Kostprijzen")
'ActiveSheet.AutoFilterMode = False
'Unlike in Excel you can insert & delete columns etc with Autofilter still turned on
'But to demonstrate turning it off I have written a routine below
subTurnOffAutoFilter
'Columns("I:I").Select
'Selection.Delete Shift:=xlToLeft
oSheet1.Columns.removebyIndex(fnColLtr2Number("I"), 1)
'leave the rest as an exercise
End Sub
sub subTurnOffAutoFilter
'This will work in OOo 1.1 or greater
'There is only 1 system defined (i.e. not user defined) database range
'and autofilter creates that database range. So turning off autofilter
'for that database range will turn off autofiltering.
dim oDbRanges as object, mRangeNames, oDBRange as object
dim i as integer
oDbRanges = StarDesktop.CurrentComponent.DatabaseRanges
mRangeNames = oDbRanges.getElementNames
for i = 0 to ubound(mRangeNames)
oDBRange = oDbRanges.getByName(mRangeNames(i))
if not oDbRange.IsUserDefined then
oDBRange.AutoFilter = false
exit for
end if
next
end sub
function fnColLtr2Number(sCol as string) as integer
dim i as integer, nCol as integer
nCol = 0
for i = 1 to len(sCol)
nCol=nCol*26 + asc(mid(sCol,i,1)) - 64
next
colLtr2Number = nCol - 1
end function
|
|
|
| Back to top |
|
|
Guest
|
| Posted: Mon Feb 16, 2004 12:01 am Post subject: what do you mean with leave the rest as an exercice ??? |
|
|
Hello thanx for helping me but you have put a comment : 'leave the rest as an exercice but dou you mean that the procedure isn't working because i have to add some conde to it, or something else ?? I have read the code and I don't understand nothing off it because you know I'm not such a programmer specialist : $
by the way thanx that you have helped me ??? ; ) |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
