03. april 2006 - 10:37
Der er
2 kommentarer og
1 løsning
XLA Hvordan gør man
Hej
Så er den gal igen.
Jeg har fået lavet en masse makroer som jeg har tildelt knapper i min værktøjslinie. Disse makroer ligger bare i selve regnearket.
Men jeg ville gerne have det sådan at alle bruge på netværket kunne åbne dette regneark(skabelon, xlt) fra en server og så henter den selv makroerne/værktøjslinien fra en xla fil, således at jeg kan nøjes med at opdatere xla-filen hvis jeg finder ændringer.
Jeg har prøvet at læse her på sitet, men jeg synes ikke jeg forstår hvad jeg skal gøre.
Kan i hjælpe så jeg forstår
03. april 2006 - 12:25
#2
Det har jeg gjort og jeg tror også jeg har fået knapper/makroerne til at blive hentet fra xla-filen. Men jeg får nogle fejlmeddelelser:
1. Object variable or with block variable not set
2. Subscript out of range
Her er min kode fra xla-filen:
Public Sub Skjul()
Application.ScreenUpdating = False
Dim iLoop As Integer
Dim rNa As Range
Dim j As Integer
Dim rX As Range
svalue = 0 'søgeværdi
scolumn = 13 'søgekolonne
iLoop = WorksheetFunction.CountIf(Columns(scolumn), svalue)
Set rNa = Cells(1, scolumn)
Set rX = Columns(scolumn).Find(What:=searchvalue, After:=rNa, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True)
For j = 1 To iLoop
Set rNa = Columns(scolumn).Find(What:=svalue, After:=rNa, _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True)
Set rX = Union(rNa, rX)
Next j
rX.EntireRow.Hidden = True
Application.ScreenUpdating = True
ActiveSheet.Cells(1, 3).Select
End Sub
Public Sub Vis()
Application.ScreenUpdating = False
Cells.Select
Selection.EntireRow.Hidden = False
Application.ScreenUpdating = True
ActiveSheet.Cells(1, 3).Select
End Sub
Public Sub Kopier()
Application.ScreenUpdating = False
Sheets("Resultat").Select
Range("O4:P100").Select
Selection.Copy
Range("P4:Q100").Select
ActiveSheet.Paste
Range("A4:A100").Select
Selection.Copy
Range("O4:O100").Select
ActiveSheet.Paste
Range("J4:J100").Select
Application.CutCopyMode = False
Selection.Copy
Range("O4:Q100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Aktiver").Select
Range("O6:P100").Select
Selection.Copy
Range("P6:Q100").Select
ActiveSheet.Paste
Range("A4:A100").Select
Selection.Copy
Range("O4:O100").Select
ActiveSheet.Paste
Range("J4:J100").Select
Application.CutCopyMode = False
Selection.Copy
Range("O4:Q100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Passiver").Select
Range("O6:P100").Select
Selection.Copy
Range("P6:Q100").Select
ActiveSheet.Paste
Range("A4:A100").Select
Selection.Copy
Range("O4:O100").Select
ActiveSheet.Paste
Range("J4:J100").Select
Application.CutCopyMode = False
Selection.Copy
Range("O4:Q100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Noter spec.").Select
Range("O4:P100").Select
Selection.Copy
Range("P4:Q100").Select
ActiveSheet.Paste
Range("A4:A100").Select
Selection.Copy
Range("O4:O100").Select
ActiveSheet.Paste
Range("J4:J100").Select
Application.CutCopyMode = False
Selection.Copy
Range("O4:Q100").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveSheet.Cells(1, 3).Select
End Sub
Public Sub Linie()
JaNej = MsgBox("Denne funktion indsætter en ny linie. Linien indsættes under den linie du står på nu. Vil du fortsætte ?", vbYesNo + vbQuestion, "Indsæt ny linie")
Select Case JaNej
Case vbYes
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
Worksheets("Stamdata").Range("200:200").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
End Select
End Sub
Public Sub Note()
JaNej = MsgBox("Denne funktion indsætter en ny note. Du skal stå på linien lige under en allerede eksisterende note. Vil du fortsætte ?", vbYesNo + vbQuestion, "Indsæt ny note")
Select Case JaNej
Case vbYes
Dim i As Integer
ActiveCell.Offset(0, 0).Select
For i = 1 To 10
Selection.EntireRow.Insert
Next
Worksheets("Stamdata").Range("202:212").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
End Select
End Sub
Public Sub Overskrift()
JaNej = MsgBox("Denne funktion indsætter en overskrift. Du skal stå på en noteoverskrift. Vil du fortsætte ?", vbYesNo + vbQuestion, "Indsæt overskrift")
Select Case JaNej
Case vbYes
If ActiveSheet.Name = "Noter spec." Then
Dim i As Integer
ActiveCell.Offset(0, 0).Select
For i = 1 To 4
Selection.EntireRow.Insert
Next
Worksheets("Stamdata").Range("227:230").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
End If
If ActiveSheet.Name = "Noter" Then
JaNej = MsgBox("Skal der kun stå 'Noter' uden årstal ?", vbYesNo + vbCritical, "Indsæt overskrift")
Select Case JaNej
Case vbYes
ActiveCell.Offset(0, 0).Select
For i = 1 To 2
Selection.EntireRow.Insert
Next
Worksheets("Stamdata").Range("232:233").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
ActiveCell.Offset(0, 0).Select
For i = 1 To 4
Selection.EntireRow.Insert
Next
Worksheets("Stamdata").Range("215:218").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
End Select
End If
If ActiveSheet.Name = "Skat. spec." Then
ActiveCell.Offset(0, 0).Select
For i = 1 To 4
Selection.EntireRow.Insert
Next
Worksheets("Stamdata").Range("221:224").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
End If
Case vbNo
End Select
End Sub
Og her fra min skabelon:
Public Sub Workbook_Open()
Application.AddIns.Add "C:\Regnskab.xla"
AddIns("Regnskab").Installed = True
End Sub
Public Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("SR").Delete
End Sub