Ann
12-29-2011, 04:07 AM
Hi,
I have a problem with the output of a questionnaire.
I get the message 'Run time error '1004': Application-defined or object-defined error'.
The questionnaire is in one worksheet and I want VBA to print the output from this to another worksheet. But VBA doesn't allow me to do that.
My code is quite long, and I have posted the code in the bottom. The problem seems to be in this fragment:
J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A:D").Rows(J).Copy ws.Columns("A:D").Rows(J).Resize(15, 1)
J = J + 15
I hope someone can help me, thank you in advance.
Private Sub CmdComplete_Click()
svar = MsgBox("Ønsker du at afslutte besvarelsen for Team 1?", vbYesNo, "Afslut besvarelse")
If svar = vbYes Then
svar = MsgBox("Du har nu afsluttet indtastningen", vbOKOnly, "Tak")
Call Resultat
End
Else
svar = MsgBox("Tilbage til indtastningen", vbOKOnly, "Om igen")
End If
End Sub
Private Sub Resultat()
Dim ws As Worksheet, Con As Controls, Raekkenr As Long, i As Long, Number As Long, Spm1 As Long, J As Long
Set ws = Worksheets("Data_Team1")
Raekkenr = ws.Cells(1, 1).CurrentRegion.Rows.Count
J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A:D").Rows(J).Copy ws.Columns("A:D").Rows(J).Resize(15, 1)
J = J + 15
With ws
Raekkenr = Raekkenr + 1
'Sengeplads 1.1
i = 6
For Number = 1 To 13
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.2
i = 6
For Number = 14 To 26
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.3
i = 6
For Number = 27 To 39
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.1
i = 6
For Number = 40 To 52
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.2
i = 6
For Number = 53 To 65
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.3
i = 6
For Number = 66 To 78
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.1
i = 6
For Number = 79 To 91
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.2
i = 6
For Number = 92 To 104
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.1
i = 6
For Number = 105 To 117
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.2
i = 6
For Number = 118 To 130
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.1
i = 6
For Number = 131 To 143
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.2
i = 6
For Number = 144 To 156
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.1
i = 6
For Number = 157 To 169
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.2
i = 6
For Number = 170 To 182
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 7
i = 6
For Number = 183 To 195
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "7"
i = i + 1
Next
i = 19
For Number = 1 To 6 Step 2
If Team1.Controls("optionbutton" & Number).Value = True Then
.Cells(Raekkenr, i).Value = "1"
Else: .Cells(Raekkenr, i).Value = "0"
End If
i = i + 1
Next
End With
Worksheets("Data_Team1").Columns.AutoFit
Spm1 = Worksheets("Spm.1.").Columns("A").CurrentRegion.Rows.Count + 1
Worksheets("Spm.1.").Cells(Spm1, 1).Value = Uge.Text
Worksheets("Spm.1.").Cells(Spm1, 2).Value = "1"
End Sub
Private Sub Forudfyld_Click()
Dim i As Integer, J As Integer
For i = 1 To 195
Team1.Controls("Tx" & i).Text = 1
Next
For J = 13 To 195 Step 13
Team1.Controls("Tx" & J).Text = ""
Next
End Sub
I have a problem with the output of a questionnaire.
I get the message 'Run time error '1004': Application-defined or object-defined error'.
The questionnaire is in one worksheet and I want VBA to print the output from this to another worksheet. But VBA doesn't allow me to do that.
My code is quite long, and I have posted the code in the bottom. The problem seems to be in this fragment:
J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A:D").Rows(J).Copy ws.Columns("A:D").Rows(J).Resize(15, 1)
J = J + 15
I hope someone can help me, thank you in advance.
Private Sub CmdComplete_Click()
svar = MsgBox("Ønsker du at afslutte besvarelsen for Team 1?", vbYesNo, "Afslut besvarelse")
If svar = vbYes Then
svar = MsgBox("Du har nu afsluttet indtastningen", vbOKOnly, "Tak")
Call Resultat
End
Else
svar = MsgBox("Tilbage til indtastningen", vbOKOnly, "Om igen")
End If
End Sub
Private Sub Resultat()
Dim ws As Worksheet, Con As Controls, Raekkenr As Long, i As Long, Number As Long, Spm1 As Long, J As Long
Set ws = Worksheets("Data_Team1")
Raekkenr = ws.Cells(1, 1).CurrentRegion.Rows.Count
J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A:D").Rows(J).Copy ws.Columns("A:D").Rows(J).Resize(15, 1)
J = J + 15
With ws
Raekkenr = Raekkenr + 1
'Sengeplads 1.1
i = 6
For Number = 1 To 13
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.2
i = 6
For Number = 14 To 26
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.3
i = 6
For Number = 27 To 39
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.1
i = 6
For Number = 40 To 52
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.2
i = 6
For Number = 53 To 65
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.3
i = 6
For Number = 66 To 78
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.1
i = 6
For Number = 79 To 91
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.2
i = 6
For Number = 92 To 104
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.1
i = 6
For Number = 105 To 117
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.2
i = 6
For Number = 118 To 130
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.1
i = 6
For Number = 131 To 143
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.2
i = 6
For Number = 144 To 156
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.1
i = 6
For Number = 157 To 169
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.2
i = 6
For Number = 170 To 182
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 7
i = 6
For Number = 183 To 195
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "7"
i = i + 1
Next
i = 19
For Number = 1 To 6 Step 2
If Team1.Controls("optionbutton" & Number).Value = True Then
.Cells(Raekkenr, i).Value = "1"
Else: .Cells(Raekkenr, i).Value = "0"
End If
i = i + 1
Next
End With
Worksheets("Data_Team1").Columns.AutoFit
Spm1 = Worksheets("Spm.1.").Columns("A").CurrentRegion.Rows.Count + 1
Worksheets("Spm.1.").Cells(Spm1, 1).Value = Uge.Text
Worksheets("Spm.1.").Cells(Spm1, 2).Value = "1"
End Sub
Private Sub Forudfyld_Click()
Dim i As Integer, J As Integer
For i = 1 To 195
Team1.Controls("Tx" & i).Text = 1
Next
For J = 13 To 195 Step 13
Team1.Controls("Tx" & J).Text = ""
Next
End Sub