Aのシートにデータがあり、BのシートからAのデータを読み込み、エクセル

質問

Aのシートにデータがあり、BのシートからAのデータを読み込み、エクセル形式で表示するVBAで組まれたエクセルがあります。
Bに読み込まれたエクセルだけを、デスクトップに保存したいのです。

ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\gsoumu7.COMP\デスクトップ\最新ver\" & bkname & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

以前は動いていたのですが、しばらくぶりに動かしたら動かなくなってしまいました。
以前はOFFICE2000か2003で今は2007になっています。

大変困っています。どなたかお助けください。

回答No.3

chibita_papa

ソースを拝見しましたが何処も問題ないように見えます。
このソースならば、Officeのバージョンの違いも関係ないと思います。
手元のＰＣで Office2003 と Office2007で検証しました。

唯一怪しいところがあるとすれば、
Officeのバージョンが変わったとの事ですが、OSのバージョンが変わったのでは
無いでしょうか。
デスクトップのアドレスは、Vistaから変わっています。
"C:\Documents and Settings\gsoumu7.COMP\デスクトップ\最新ver\"
このアドレスは存在しますか。

回答No.2

myRange

回答１、myRangeです。

最初の質問では、上手く動かない、とあり、それがどういう状態を意味しているのか書いてありませんでした。
が、保存のコードが提示されてましたので、保存が上手くいかない、（エラーが出る）と判断しての回答をしました。

保存の部分は、当方の回答で上手くいきます。

それを踏まえて、、、、

今度もただ「上手くいかない」との文言と少々の追加コードだけですね。
なぜ、「上手くいかない」がどういう状態を指しているのか明確にしないのでしょうか。

追加コード部分は２００７でも問題なく動作するものです。
但し、変数の値が正しければ、ですが。
しかし、２００３では動作してたコードだということですからそこらはＯＫでしょう。
ということで、動かない原因はその他の部分にあると推測できます。

何れにしろ、問題を解決したいのであれば、
質問者のいう「上手くいかない」がどういう状態を指しているのか明確にしてください。
また、エラーが表示されるのならそのメッセージも必要です。
エラーダイアログには「デバック」というボタンがありますからそれをクリックすれば原因のコード部分に色が付きますので、それも提示してください。

そうすれば瞬く間に解決するでしょう。

ところで、なぜ、他にもあるであろうコードの中から、お礼のコード部分だで提示しのでしょうか。
そこに上手くいかない原因があると判断したからですよね。
序にそう考える理由も提示のこと。

以上です。

お礼

あなたのおっしゃる通りです。
質問の方法もさることながら、「教えて！ｇｏｏ」の使い方もわからず、回答欄にコメントしたり大変失礼しました。
月曜日にもう一度色々試してみます。

このエクセルが動かないと非常に困るので頑張ります。
ありがとうございました。

回答No.1

myRange

VBAを使うなら、２００７とそれより前のバージョンのファイル形式の違いを知っておかないといけません。
ま、それはこれから勉強するとして。。。

引数FileFormatの値xlNormalをxlExcel8に変更する。

ActiveWorkbook.SaveAs _
Filename:="C:\Documents and Settings\gsoumu7.COMP\デスクトップ\最新ver\" & bkname & ".xls", _
FileFormat:=xlExcel8　　←●ここを修正

以上です。

補足

アドバイスのように変更してみましたが、うまく行きません。他にもバグがあるのだと思います。ありがとうございました。
もし、お時間があるようでしたら、ソースをご覧ください。

Private Sub Worksheet_activate()

Application.MoveAfterReturnDirection = xlDown
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A4").Select

End Sub
Private Sub fabao_Click()

initial_sub
ActiveWorkbook.Unprotect
Workbooks(shb).Worksheets(shs).Unprotect
Workbooks(kgb).Worksheets(kgs).Unprotect
Workbooks(sgb).Worksheets(sgs).Unprotect
Dim bkname As String

If Not Cells(4, 1).Value <> 0 Then
MsgBox ("There is no code.")
Exit Sub
Else
End If

bkname = Cells(4, 1).Value & " " & Cells(4, 2).Value

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' 保存先の選択・ C:\Documents and Settings\new\ラタ
'*********************************************************************************
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\gsoumu7.COMP\デスクトップ\最新ver\" & bkname & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'