Lave en XLA-fil

Jeg vil meget gerne poste mine makroer her hvis der er nogle som gider at lave xla-filen for mig og fortælle mig lidt udførligt hvordan jeg implementer den i min skabelon

Både xla filen og skabelonen kommer til at ligge på en server og altså ikke lokalt hos den enkelte bruger

Jeg har fået lagt makroerne i en xla-fil

Jeg har tilføjet denne i tilføjelsesprogrammer.

Jeg kan kalde mine makroer fra min værktøjslinie i den nye xla fil.

MEN jeg får nu lige pludselig fejlmeddelelser ved udførsel af makroerne ?

Jeg bliver lige ved at poste lidt beskeder i håb om at nogle vil hjælpe mig.

Har det noget at gøre med subrutiner og om makroerne en globale ?

Jeg prøver at læse lidt i andre spg. her på Experten men bliver ikke meget klogere, snarere mere forvirret.

Jeg ved ikke om det kan lade sig gøre.

Det ville være rart at vide hvilke fejl du får.
Du kan evt. i stedet for putte makroerne i person.xls.
Prøv at følge med her: http://www.eksperten.dk/spm/731986

Sådan ser min makroer ud (sorry for at jeg poster det hele):

Jeg får generelt fejlen (object variable or with block variable not set). Denne fejl kommer i alle andre makroer end den første.

Og i den første makro udfører den det den skal, men skriver altid fejlmeddelesen også (den er ingen nul.....)

Jeg har lagt mine makroer i thisworkbook i min xla-fil og sådan ser de ud:

Sub Skjul()
On Error GoTo Fejl
Application.ScreenUpdating = False
Dim iLoop As Integer
Dim rNa As Range
Dim i 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 i = 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 i
rX.EntireRow.Hidden = True
Application.ScreenUpdating = True
ActiveSheet.Cells(1, 3).Select
Exit Sub
Fejl:
  MsgBox "Der er ingen nul-linier at skjule !"

End Sub

Sub Vis()
  Application.ScreenUpdating = False
  Cells.Select
  Selection.EntireRow.Hidden = False
  Application.ScreenUpdating = True
  ActiveSheet.Cells(1, 3).Select
  End Sub
 
Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Fejl
Application.CommandBars("SR").Delete
Exit Sub
Fejl:
 
End Sub
Sub Linie()
If ActiveSheet.Name = "Fors." Then
Exit Sub
Else
If ActiveSheet.Name = "Indh." Then
Exit Sub
Else
If ActiveSheet.Name = "Sel.opl." Then
Exit Sub
Else
If ActiveSheet.Name = "Led.påt." Then
Exit Sub
Else
If ActiveSheet.Name = "Rev.påt." Then
Exit Sub
Else
If ActiveSheet.Name = "Led.ber." Then
Exit Sub
Else
If ActiveSheet.Name = "Prak." Then
Exit Sub
Else
If ActiveSheet.Name = "Fors.spec." Then
Exit Sub
Else
If ActiveSheet.Name = "Indh.spec." Then
Exit Sub
Else
If ActiveSheet.Name = "Erkl.spec." Then
Exit Sub
Else
If ActiveSheet.Name = "Nøgle" Then
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
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("Data").Range("200:200").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
End Select
End Sub
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
If ActiveSheet.Name = "Noter spec." Then
Dim i
ActiveCell.Offset(0, 0).Select
For i = 1 To 10
Selection.EntireRow.Insert
Next

Worksheets("Data").Range("202:212").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Else
MsgBox "Du står ikke på arket 'Noter spec.' ! eller 'Noter' !"
End If
If ActiveSheet.Name = "Noter" Then
ActiveCell.Offset(0, 0).Select
For i = 1 To 10
Selection.EntireRow.Insert
Next

Worksheets("Data").Range("188:198").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Else
MsgBox "Du står ikke på arket 'Noter spec.' ! eller 'Noter' !"
End If
Case vbNo
End Select
End Sub
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" Then
JaNej = MsgBox("Skal der kun stå 'Noter' uden årstal ?", vbYesNo + vbQuestion, "Indsæt overskrift")
Select Case JaNej
Case vbYes
ActiveCell.Offset(0, 0).Select
For i = 1 To 2
Selection.EntireRow.Insert
Next

Worksheets("Data").Range("215:216").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
ActiveCell.Offset(0, 0).Select
For i = 1 To 5
Selection.EntireRow.Insert
Next

Worksheets("Data").Range("215:219").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
End Select
Else
MsgBox "Du står ikke på arket 'Noter' !"
End If
Case vbNo
End Select
End Sub

Sub Sidetal()
Dim pn As Variant
JaNej = MsgBox("Skal sidetallet sættes til 'Auto' ?", vbYesNo + vbQuestion, "Ret sidetal")
Select Case JaNej
Case vbYes
With ActiveSheet.PageSetup
            .FirstPageNumber = xlAutomatic
         
        End With
Case vbNo
        pn = Application.InputBox("Indtast sidetal på arket", "Ret sidetal")
       
        If pn = False Then Exit Sub
       
        With ActiveSheet.PageSetup
            .FirstPageNumber = pn
           
        End With
 
End Select
End Sub

Sub Vis()
  Application.ScreenUpdating = False
  Cells.Select
  Selection.EntireRow.Hidden = False
  Application.ScreenUpdating = True
  Cells(1, 3).Select
End Sub


Sub Linie()
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
wn = wa.Name
If wn = "Fors." Then
Exit Sub
Else
If wn = "Indh." Then
Exit Sub
Else
If wn = "Sel.opl." Then
Exit Sub
Else
If wn = "Led.påt." Then
Exit Sub
Else
If wn = "Rev.påt." Then
Exit Sub
Else
If wn = "Led.ber." Then
Exit Sub
Else
If wn = "Prak." Then
Exit Sub
Else
If wn = "Fors.spec." Then
Exit Sub
Else
If wn = "Indh.spec." Then
Exit Sub
Else
If wn = "Erkl.spec." Then
Exit Sub
Else
If wn = "Nøgle" Then
Exit Sub
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
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

wb.Worksheets("Data").Range("200:200").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
End Select
End Sub

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
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
wn = wa.Name
If wn = "Noter spec." Then
Dim i
ActiveCell.Offset(0, 0).Select
For i = 1 To 10
Selection.EntireRow.Insert
Next

wb.Worksheets("Data").Range("202:212").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Else
MsgBox "Du står ikke på arket 'Noter spec.' ! eller 'Noter' !"

End If
If wn = "Noter" Then
ActiveCell.Offset(0, 0).Select
For i = 1 To 10
Selection.EntireRow.Insert
Next

wb.Worksheets("Data").Range("188:198").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Else
MsgBox "Du står ikke på arket 'Noter spec.' ! eller 'Noter' !"
End If
Case vbNo
End Select
End Sub

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
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
wn = wa.Name
If wn = "Noter" Then
JaNej = MsgBox("Skal der kun stå 'Noter' uden årstal ?", vbYesNo + vbQuestion, "Indsæt overskrift")
Select Case JaNej
Case vbYes
ActiveCell.Offset(0, 0).Select
For i = 1 To 2
Selection.EntireRow.Insert
Next

wb.Worksheets("Data").Range("215:216").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
Case vbNo
ActiveCell.Offset(0, 0).Select
For i = 1 To 5
Selection.EntireRow.Insert
Next

wb.Worksheets("Data").Range("215:219").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
End Select
Else
MsgBox "Du står ikke på arket 'Noter' !"
End If
Case vbNo
End Select
End Sub

o.s.v

Vil du være sød at lave makro:

skjul
sidetal
noter (den virker men skriver fejlmedelelsen lige bagefter)

Jeg kan ikke lige selv finde ud af det.

Bonusspørgsmål. kan man også placeres værktøjslinien i xla-filen ?

Håber du gider at hjælpe

Hvor enten værktøjslinien skal placeres xla eller skabelon, skal den forsvinde ved lukning af exceldokumentet.

Virker de andre?

Alle de andre virker:

dvs.

vis
indsæt linie
overskrift
noter (bortset fra at den viser fejlmeddelelsen bagefter)

Sub Skjul()
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
wn = wa.Name
On Error GoTo Fejl
Application.ScreenUpdating = False
Dim iLoop As Integer
Dim rNa As Range
Dim i 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 i = 1 To iLoop

  Set rNa = wb.Sheets(wn).Columns(scolumn).Find(What:=svalue, After:=rNa, _
            LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=True)
  Set rX = Union(rNa, rX)
 
Next i
rX.EntireRow.Hidden = True
Application.ScreenUpdating = True
Cells(1, 3).Select
Exit Sub
Fejl:
  MsgBox "Der er ingen nul-linier at skjule !"

End Sub

Sub Sidetal()
Dim pn As Variant
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
JaNej = MsgBox("Skal sidetallet sættes til 'Auto' ?", vbYesNo + vbQuestion, "Ret sidetal")
Select Case JaNej
Case vbYes
With wa.PageSetup
            .FirstPageNumber = xlAutomatic
         
        End With
Case vbNo
        pn = Application.InputBox("Indtast sidetal på arket", "Ret sidetal")
       
        If pn = False Then Exit Sub
       
        With ActiveSheet.PageSetup
            .FirstPageNumber = pn
           
        End With
 
End Select
End Sub

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
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
wn = wa.Name
If wn = "Noter spec." Or wn = "Noter" Then
    Dim i
    ActiveCell.Offset(0, 0).Select
    For i = 1 To 10
        Selection.EntireRow.Insert
    Next
    If wn = "Noter" Then
        wb.Worksheets("Data").Range("188:198").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
    Else
        wb.Worksheets("Data").Range("202:212").EntireRow.Copy Destination:=ActiveCell.Offset(0, 0).EntireRow
    End If
Else
    MsgBox "Du står ikke på arket 'Noter spec.' ! eller 'Noter' !"
End If
Case vbNo
End Select
End Sub

Kn ikke få Note til at lave fejl, men har omskrevet den lidt. Se om du får fejl.

Det eneste som jeg kan se der umiddelbart ikke virker er sidetal.

Autosidetal virker men ikke hvis man selv indtaster et sidetal.

Ved du det om værktøjslinien kan placeres i xla filen.
Og om hvordan jeg får lukket værktøjslinien ved lukning af excelarket.

Min pointe er at der ligger en fast skabelon (xlt).

Når man åbner den er der altid tilføjet (via tilføjelsesprogrammer)en xla-fil. Dsv. jeg kan rette makroer og værktøjslinien i xla-filen og så bliver det altid den nyeste version man får i skabelonen.

Er jeg på rette vej med din fantastiske hjælp ?

Det må du undskylde. fik åbenbart ikke testet ordentligt.

Sub Sidetal()
Dim pn As Variant
Set wb = ActiveWorkbook
Set wa = wb.ActiveSheet
JaNej = MsgBox("Skal sidetallet sættes til 'Auto' ?", vbYesNo + vbQuestion, "Ret sidetal")
Select Case JaNej
Case vbYes
With wa.PageSetup
            .FirstPageNumber = xlAutomatic
        End With
Case vbNo
        pn = Application.InputBox("Indtast sidetal på arket", "Ret sidetal")
        If pn = False Then Exit Sub
        With wa.PageSetup
            .FirstPageNumber = pn
        End With
 
End Select
End Sub


Du kan sagtens oprette værktøjsbjælken fra .xla filen. Men du skal så vidt jeg husker lægge selve koden i et modul

I ThisWorkbook
Private Sub Workbook_Open()
OpretVkLinie
End Sub

I Module1
sub OpretVkLinie()
  noget...
End Sub

Det kan egentlig godt være samme problem du har haft i de andre makroer - pladseringen af selve makroerne.

Det virker perfekt med sidetal nu.

Jeg driver lige lidt rovdrift på dig og spørger lidt mere til værktøjslinien.

Jeg har jo allerede en værktøjslinie i skabelonen, kan man ikke bare ligge den i xla-filen eller virker det ikke.

Jeg forstår ikke helt dit eksempel

Sig til når du ikke gider mere.

I ThisWorkbook
Private Sub Workbook_Open()
OpretVkLinie 'kalder på makroen OpretVkLinie
End Sub

I Module1
sub OpretVkLinie()
  Koden til din oprettelse af værktøjslinie
End Sub

Hej igen

Jeg forstår stadig ikke hvilken kode jeg skal skrive i min xla-fil, selvom du har givet et eksempel.

Jeg har jo ikke nogle kode for værktøjslinien i min nuværende skabelon ?

Så hvis du gider at hjælpe mere vil det være perfekt eller smider du bare et svar og så får du selvfølgelig point for din hjælp med det andet.

Ved et nyt, tomt Exceldokument. Tryk Alt+F11. Du er nu inde i VBA editoren. I 'verste venstre vindue har du

Ark1 (Ark1)
Ark2 (Ark2)
Ark3 (Ark3)
ThisWorkbook

Dobbeltklik dig ind i ThisWorkbook og indsæt

Private Sub Workbook_Open()
OpretVkLinie 'kalder på makroen OpretVkLinie
End Sub

OBS: Check selvfølgelig lige at Private Sub Workbook_Open() ikke allerede er oprettet. I så fald putter du jo bare koden

OpretVkLinie 'kalder på makroen OpretVkLinie

..ind som første linie i ThisWorkbook_Open.

Derefter højreklikker du på Ark1 (Ark1). Der fremkommer en menu, bl.a med "Insert". Kører du musen ned på denne, står der "Userform", "Module", og "Class Module".
Vælg Module.
Der bliver indsat et modul der hedder "Module1", der ligger i en "folder" der hedder Modules.

Alt hvad der ligger af kode i et modul er "offentligt tilgængelig", og kan ses fra Ark1, Ark2 o.s.v. samt fra ThisWorkbook, i hvertfald det ikke bliver deklareret som Private.

Kort sagt, hvis du vil køre en makro via eksempelvis funktioner -> makro -> afspil makroer i Excelarket, skal de ligge i et modul og ikke i ThisWorkbook. Optager du automatisk en makro fra Excel, vil der automatisk blive oprettet et modul, hvor koden kommer ind. Prøv eksempelvis at optage en makro i et tomt, nyt ark. Så kan du se det.

Tilbage til koden:
I det nyoprettede modul putter du koden
sub OpretVkLinie()
  'og her Koden til din oprettelse af værktøjslinie
End Sub

Spørg, hvis du ikke er med!!!

Jeg er sådan set godt med på hvor jeg skal placere koden...( jeg går her udfra er vi er enige om at det er i xla-filen det skal placeres.)

Men det sidste du skriver 'og her Koden til din oprettelse af værktøjslinie

Det ved jeg ikke hvor jeg får det fra ? Hvilken kode ? Den jeg har lavet foreløbig i min skabelon er via menuen Funktioner/tilpas og en ny linie, der er jo ikke noget kode nogle steder ? eller hva' ?

Ok, du har ikke koden til oprettelse af en værktøjslinie? Hvad så med Application.CommandBars("SR").Delete???

Oprettelse af commandbar (Værktøjslinie):

Dim mnu As CommandBar
    For Each mnu In Application.CommandBars
        If mnu.Name = "SR" Then Exit Sub
    Next
Set myBar = CommandBars _
    .Add(Name:="SR", Position:=msoBarTop, _
    Temporary:=True)
myBar.Visible = True

Set NewKnap = myBar.Controls _
    .Add(Type:=msoControlButton, ID:=1851)
With NewKnap
    .Caption = "Jeg gør et eller andet"
    .OnAction = "Skjul"
End With

Set NewKnap = myBar.Controls _
    .Add(Type:=msoControlButton, ID:=1851)
With NewKnap
    .Caption = "Jeg gør noget andet"
    .OnAction = "Vis"
End With
End Sub

o.s.v.

Se ev. mere her: http://www.eksperten.dk/spm/730267

Denne kode fjerner bare den værktøjslinie jeg har lavet via Funktioner-tilpas, således at den ikke bliver hængende i Excel når jeg lukker min skabelon.

Værktøjslinien har jeg kaldt SR og vedhæfter den skabelonen.

Er det bare mig som ikke fatter om der er en kode eller ej ?

Det er ikke kode, men en handling. Du kan oprette en værktøjslinie som ovenstående viser. Sæt det ind i

Private Sub Workbook_Open()

End Sub

Jeg kigger på det...takker

Du spørger bare... "ID:=1851" fortæller hvilket symbol(ikon) du vil have vist.