| |
No.599の投稿との関連です。
現在、以下の作業をおこなっています。
1.Wordから作成したUserformを呼び出す。
2.Userformに記入した内容を自動的に所定のExcelファイルに保存する。
3.このWordファイルをWebページとして保存し、HP上にUpする。
1.と2.までは等質問箱の方の助力のおかげでできたのですが、3.がうまくいきません。
まず第一に、Word上にUserformを出現させるCommand Buttonを置いているのですが、Web page上ではUserformが出現しません。
(同じことをExcelをwebに載せて行った時はUserformは出現します。)
これは何か特別なプログラムを組む必要があるのですか？
次に、この内容は2.の段階のものなのですが、デスクトップ上でWordからExcelを参照し自動保存を行った時、一回目は何もerrorが出ずにできるのですが、そのままWordを閉じずに同じことを実行するとerrorが出ます。（一度Wordを保存して、もう一度同じことをしたときにはerrorはでません。）参考に内容を添えるので原因を教えていただきたいです。いつも始めのrangeのところや、Do untilのところでErrorが出ます。
Private Sub Enter_Click()
Dim ExObj As Object
Dim objwb As Object
Dim wbpath As String
wbpath = "C:\Documents and Settings\アンケート"
Set ExObj = CreateObject("Excel.Application")
Set objwb = ExObj.Workbooks.Open(wbpath)
'入力場所選択
objwb.Sheets("データ").Select
Range("A2").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
'Data入力
ActiveCell.FormulaR1C1 = "=R[-1]C+1"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label6
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label5
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label7
ActiveCell.Offset(0, -6).Select
'月別Data入力
ActiveCell.Copy
If Format(Text入力日付, "mm") = "10" Then
Sheets("10月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "11" Then
Sheets("11月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "12" Then
Sheets("12月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "01" Then
Sheets("1月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "02" Then
Sheets("2月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "03" Then
Sheets("3月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "06" Then
Sheets("6月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "07" Then
Sheets("7月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "08" Then
Sheets("8月").Select
ElseIf Format(UserForm1.Text入力日付, "mm") = "09" Then
Sheets("9月").Select
End If
Range("A2").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label6
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label5
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Label7
Me.Hide
objwb.Save
objwb.Close
Set objwb = Nothing
ExObj.Quit
Set ExObj = Nothing
End Sub
|
|
青
- 09/3/18(水) 11:26 -
![[未読]](./data/word/image/read_icon.gif){kind=icon}
≪
