Dynamisk userform
HejsaJeg har følgende kode i et modul i en global xla-fil. Det er en funktion som laver en udskrift-userform (se nederst).
Problemet er vist denne linie som får Excel til at bryde ned (er jeg blevet fortalt):
'.ControlSource = Y.Name & "!$A$1" (lige nu er den inaktiv).
Løsningen fra en ven er følgende:
Aktiver ovenstående linie igen (dvs. fjern ')
Og put følgende i ThisWorkBook i min Excel fil:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each Kontrol In UserForm5.Controls
If Left(Kontrol.Name, = "CheckBox" Or Left(Kontrol.Name, 12) =
TextBoxAntal" Then
UserForm5.Controls.Remove (Kontrol.Name)
End If
Next
End Sub
Men den fejler på denne linie hver gang jeg lukker filen:
For Each Kontrol In UserForm5.Controls
Det virker som om den ikke kan finde min userform når den nu ligger i en xla-fil.
Er der nogle som kan hjælpe mig. Funktionen virker perfekt, det eneste problem er sådan set at den får Excel til at bryde ned med jævne mellemrum ???
Koden:
Public I As Long, GlArk As String, Adskiller1, Adskiller2
Private Sub Udskriv_Click()
Dim D As Long, W, Antal
W = 0
ReDim Arkene(0)
ReDim Antal(0)
For D = 1 To I
If Me.Controls("CheckBox" & D).Value = True Then
If Not IsNumeric(Me.Controls("TextBoxAntal" & D).Value) And Me.Controls("TextBoxAntal" & D).Value > 0 Then
'Exit Sub
End If
ReDim Preserve Arkene(W)
Arkene(W) = Me.Controls("CheckBox" & D).Caption
ReDim Preserve Antal(W)
Antal(W) = Me.Controls("TextBoxAntal" & D).Value
W = W + 1
End If
Next
If W = 0 Then
MsgBox "Ingen ark valgt!"
Exit Sub
End If
A = Application.Dialogs(xlDialogPrinterSetup).Show
If A = False Then
MsgBox "Du valgte ikke printer!" & Chr(10) & "Udskrivning blev afbrudt!"
Sheets(GlArk).Select
Exit Sub
End If
Sheets(Arkene).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets(GlArk).Select
Me.Hide
End Sub
Private Sub VisUdskrift_Click()
W = 0
ReDim Arkene(0)
For D = 1 To I
If Me.Controls("CheckBox" & D).Value = True Then
If Not IsNumeric(Me.Controls("TextBoxAntal" & D).Value) And Me.Controls("TextBoxAntal" & D).Value > 0 Then
'Exit Sub
End If
ReDim Preserve Arkene(W)
Arkene(W) = Me.Controls("CheckBox" & D).Caption
W = W + 1
End If
Next
If W = 0 Then
MsgBox "Ingen ark valgt!"
Exit Sub
End If
Me.Hide
Sheets(Arkene).Select
ActiveWindow.SelectedSheets.PrintPreview
Sheets(GlArk).Select
'Me.Show 'Viser formen igen
End Sub
Private Sub Annuller_Click()
UserForm5.Hide
End Sub
Private Sub UdskrivBox1_Click()
If Me.UdskrivBox1 = True Then
Me.Controls("UdskrivBox2").Value = False
For D = 3 To 6
Me.Controls("UdskrivBox" & D).Value = True
Next
End If
For D = 1 To 28
Me.Controls("CheckBox" & D).Value = True
Next
Me.UdskrivBox1 = True
End Sub
Private Sub UdskrivBox2_Click()
If Me.UdskrivBox2 = True Then
Me.Controls("UdskrivBox1").Value = False
For D = 3 To 6
Me.Controls("UdskrivBox" & D).Value = False
Next
For D = 1 To I
Me.Controls("Checkbox" & D).Value = False
Next
Me.UdskrivBox2 = True
End If
End Sub
Private Sub UdskrivBox3_Click()
If UdskrivBox3.Value = True Then
Me.Controls("UdskrivBox1").Value = False
Me.Controls("UdskrivBox2").Value = False
For D = 1 To Adskiller1
Me.Controls("CheckBox" & D).Value = True
Next
Else
For D = 1 To Adskiller1
Me.Controls("CheckBox" & D).Value = False
Next
End If
CheckState
End Sub
Private Sub UdskrivBox4_Click()
If UdskrivBox4.Value = True Then
Me.Controls("UdskrivBox1").Value = False
Me.Controls("UdskrivBox2").Value = False
For D = Adskiller1 + 1 To Adskiller2 - 1
Me.Controls("CheckBox" & D).Value = True
Next
Else
For D = Adskiller1 + 1 To Adskiller2 - 1
Me.Controls("CheckBox" & D).Value = False
Next
End If
CheckState
End Sub
Private Sub UdskrivBox5_Click()
If UdskrivBox5.Value = True Then
Me.Controls("UdskrivBox1").Value = False
Me.Controls("UdskrivBox2").Value = False
For D = Adskiller2 To 21
Me.Controls("CheckBox" & D).Value = True
Next
Else
For D = Adskiller2 To 21
Me.Controls("CheckBox" & D).Value = False
Next
End If
CheckState
End Sub
Private Sub UdskrivBox6_Click()
If UdskrivBox6.Value = True Then
Me.Controls("UdskrivBox1").Value = False
Me.Controls("UdskrivBox2").Value = False
For D = 24 To 27
Me.Controls("CheckBox" & D).Value = True
Next
Else
For D = 24 To 27
Me.Controls("CheckBox" & D).Value = False
Next
End If
CheckState
End Sub
Private Sub UserForm_activate()
Dim Y, FraTop, VJust As Long, Dobbelt As Boolean
On Error Resume Next
Sheets("Noter spec.").Name = "Noter.spec."
If Err.Number = 9 Then
Err.Clear
End If
GlArk = ActiveSheet.Name
VJust = 0
FraTop = 22
Application.ScreenUpdating = False
If ActiveWorkbook.Sheets(13).Name = "Penge" Then
Arkene = Array("Skat.afst.", "Selv4", "Selv3", "Selv2", "Selv1", "Gen.fors.", "Regn.erkl.", "Rev.prot.", "Til.prot.", "Nøgle", "Noter.spec.", "Skat.spec.", "Skat.res.", "Erkl.spec.", "Indh.spec.", "Fors.spec.", "Noter", "Penge", "Pas.", "Akt.", "Res.", "Prak.", "Led.ber.", "Rev.påt.", "Led.påt.", "Sel.opl.", "Indh.", "Fors.", "Stam", "Data")
Adskiller1 = 12
Adskiller2 = 20
Else
Arkene = Array("Skat.afst.", "Selv4", "Selv3", "Selv2", "Selv1", "Gen.fors.", "Regn.erkl.", "Rev.prot.", "Til.prot.", "Nøgle", "Penge", "Noter.spec.", "Skat.spec.", "Skat.res.", "Erkl.spec.", "Indh.spec.", "Fors.spec.", "Noter", "Pas.", "Akt.", "Res.", "Prak.", "Led.ber.", "Rev.påt.", "Led.påt.", "Sel.opl.", "Indh.", "Fors.", "Stam", "Data")
Adskiller1 = 11
Adskiller2 = 20
End If
For Flyt = 1 To UBound(Arkene)
Sheets(Arkene(Flyt)).Move Before:=Sheets(1)
Next
Sheets(GlArk).Activate
Application.ScreenUpdating = True
For Each Kontrol In UserForm5.Controls
If Left(Kontrol.Name, 8) = "CheckBox" Or Left(Kontrol.Name, 12) = "TextBoxAntal" Then
UserForm5.Controls.Remove (Kontrol.Name)
End If
Next
'If I > 0 Then GoTo Skip 'Hvis arkene er fundet
I = 0
For Each Y In ActiveWorkbook.Sheets
If Y.Name = "Data" Or Y.Name = "Data" Or Y.Name = "Stam" Then GoTo næste: 'Ændrer selv arknavne
I = I + 1
If I = 15 Then
Dobbelt = True
VJust = 1
D = 170
Else
VJust = VJust + 1
End If
Set lb = UserForm5.Controls.Add("Forms.CheckBox.1", "CheckBox" & I, True)
With lb
.Top = FraTop + 18 * VJust
.Left = D + 20
.Caption = Y.Name
.Value = True
End With
Set lb = UserForm5.Controls.Add("Forms.TextBox.1", "TextBoxAntal" & I, True)
With lb
.Top = FraTop + 18 * VJust
.Left = D + 100
.Value = ""
.Width = 30
.Enabled = True
.Locked = False
If Sheets(Y.Name).Range("A1").Value <> "" Then
'.ControlSource = Y.Name & "!$A$1"
End If
.SpecialEffect = 0
.BackColor = &H8000000F
End With
næste:
Next
If D > 0 Then
Me.Width = 420
Me.Height = 380
Me.Udskriv.Top = 12
Me.Udskriv.Left = 320
Me.Annuller.Top = 42
Me.Annuller.Left = 320
Me.VisUdskrift.Top = 72
Me.VisUdskrift.Left = 320
Me.Frame1.Left = 310
Me.TextBox1.Left = 20
Me.TextBox2.Left = 80
Me.TextBox3.Left = 190
Me.TextBox4.Left = 250
Me.Image1.Left = 330
Else
Me.Width = 180
End If
Skip:
CheckState
End Sub
Sub CheckState()
Dim Alle As Boolean, IkkeAlle As Boolean
Alle = True
IkkeAlle = True
For D = 1 To 28
If Me.Controls("CheckBox" & D).Value = False Then
Alle = False
End If
If Me.Controls("CheckBox" & D).Value = True Then
IkkeAlle = False
End If
Next
If Alle = True Then
Me.Controls("UdskrivBox1").Value = True
Else
Me.Controls("UdskrivBox1").Value = False
End If
If IkkeAlle = True Then
Me.Controls("UdskrivBox2").Value = True
End If
End Sub
