Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

237 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77702】Re:アクセス制限されているフォルダへの...

γ - 15/12/1(火) 21:08 -


	引用なし

	パスワード

マクロでアクセスするユーザーであっても、
何か特別の計らいをしてくれるわけではないと思います。

適当な譬えかどうか不明ですが、
マンションの一住民が、マンション全戸に出入りを要望するような感じです。
それは管理人さんの権限です。
管理人さんを通さないと勝手な例外は作れません。

何か別のアプローチを工夫してみてはどうでしょう。

・ツリー全体表示


	【77701】Re:非表示の別ブックにシートコピーでき...

γ - 15/12/1(火) 21:02 -


	引用なし

	パスワード

解決策ということでもないのですが、
それは仕様のようですから如何ともしがたいでしょう。
コピーしてから非表示にするとか、別の方法で対応してはどうでしょう。

・ツリー全体表示


	【77700】アクセス制限されているフォルダへの保存

はむ - 15/12/1(火) 17:45 -


	引用なし

	パスワード

お世話になります。

ファイル管理のマクロを作成したいと思っています。
ファイルを保存するフォルダへはマクロからのみファイルを保存、削除、上書きできるようにし、windows上からは直接いじれないようにしたいです。
そこでマクロからユーザ名、パスワードを指定してファイルを保存などすることは可能でしょうか？

サーバ名:server
フォルダ名:tf
一般ユーザ:アクセス権なし
マクロ用ユーザ:フルアクセス

一般ユーザがマクロを使い、ファイルを保存するときマクロ用ユーザで保存したいです。

お手数ですが、よろしくお願いします

・ツリー全体表示


	【77699】非表示の別ブックにシートコピーできない

yy - 15/12/1(火) 10:47 -


	引用なし

	パスワード

自分のExcelブック(自ブック)からVBAで、
もう1つ別のExcelブック(他ブック)を非表示で開いて、
自ブックと他ブックの間でシートをコピーしたいのですが、
他ブックのシートを自ブックにコピーすることはできるのですが、
自ブックのシートを他ブックにコピーするとなぜかエラーになります。
例えば、以下のsampleで、
(A)では、正しくシートがコピーされるのですが、
(B)では、
「実行時エラー'1004' WorksheetクラスのCopyメソッドが失敗しました。」
というエラーになります。
なぜ(A)はOKなのに(B)ではエラーになるのでしょうか。
(B)の部分をどのように記述すればよいのでしょうか。

よろしくお願いします。(Windows7,Excel2010)

--------------------------------------------------
Sub sample()

　Dim ExcelBook As Excel.Workbook
　Dim FileNameFullPath As String

　FileNameFullPath = ThisWorkbook.Path & "\Book1.xlsx"
　Set ExcelBook = Workbooks.Open(FileNameFullPath, UpdateLinks:=0)

　Application.Windows("Book1.xlsx").Visible = False

　'他ブックのシートを自ブックにコピーする (正常)
　ExcelBook.Worksheets("Sheet1").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '<-(A)

　'自ブックのシートを他ブックにコピーする (エラー)
　ThisWorkbook.Worksheets("Sheet1").Copy after:=ExcelBook.Sheets(ExcelBook.Sheets.Count) '<-(B)

　Application.Windows("Book1.xlsx").Visible = True

　Application.DisplayAlerts = False
　ExcelBook.Save
　ExcelBook.Close
　Application.DisplayAlerts = True
　Set ExcelBook = Nothing

End Sub
--------------------------------------------------
(注記1) Application.Windows("Book1.xlsx").Visible = False
　　　　の部分を、
　　　　Application.ScreenUpdating = False
　　　　にすると、このエラーは起きませんが、
　　　　タスクバーに表示されてしまいます。
(注記2) Set ExcelBook = Workbooks.Open(FileNameFullPath, UpdateLinks:=0)
　　　　の部分を、
　　　　Dim objEX As Excel.Application
　　　　Set objEX = CreateObject("Excel.Application")
　　　　Set ExcelBook = objEX.Workbooks.Open(FileNameFullPath, UpdateLinks:=0)
　　　　のうに、別インスタンスで開くと、このエラーは起きませんが、
　　　　別インスタンス間ではシートのコピーができません。
(注記3) シートのコピーをコピー&ペーストの機能で代用すると、
　　　　セルに施されているフィルターなどの設定が外れてしまいます。

・ツリー全体表示


	【77698】Re:四角形吹き出しの先っぽにあたる点が...

mumu - 15/11/30(月) 23:29 -


	引用なし

	パスワード

γ 様

迅速な回答、感謝いたします。
すごいです。
やりたいことに一歩近づけました。

書いていただいたコード、今の私の知識だと
半分も理解できてないですが、何とか読み解いて
自分のものにしたいです。

ありがとうございました。

・ツリー全体表示


	【77697】Re:四角形吹き出しの先っぽにあたる点が...

γ - 15/11/30(月) 22:35 -


	引用なし

	パスワード

こんなことでしょうか。
それを選択状態にして実行してください。

Sub test()
　　Dim sp As ShapeRange
　　Dim a　As Adjustments
　　Dim wTop As Double, wLeft As Double, wWidth As Double, wHeight As Double
　　Dim l As Double, t As Double
　　Dim ovl As Shape
　　
　　Set sp = Selection.ShapeRange
　　wTop = sp.Top
　　wLeft = sp.Left
　　wWidth = sp.Width
　　wHeight = sp.Height
　　
　　Set a = sp.Adjustments
　　l = wLeft + 0.5 * wWidth + a.Item(1) * wWidth
　　t = wTop + 0.5 * wHeight + a.Item(2) * wHeight
　　Set ovl = ActiveSheet.Shapes.AddShape(msoShapeOval, l, t, 1, 1)
　　MsgBox ovl.TopLeftCell.Address
　　ovl.Delete
End Sub

・ツリー全体表示


	【77696】四角形吹き出しの先っぽにあたる点がどの...

mumu - 15/11/30(月) 21:56 -


	引用なし

	パスワード

はじめて投稿させていただきます。

シート内に複数の四角形吹き出しがある場合、
個々の四角形吹き出しの左上端のセルは、TopLeftCell、
右下端のセルはBottomRightCell
で取得できたのですが、吹き出しの先っぽにあたる点（Adjustments.Item?）が
どのセル上にあるか知りたい場合はどうすればいいでしょうか？

初心者のため、見当違いの質問をしているかもしれませんが、
どうかご教授お願い致します。

・ツリー全体表示


	【77695】Re:VBAを使い、別シートにデータを抽出し...

β - 15/11/30(月) 17:57 -


	引用なし

	パスワード

▼たけちゃんまんさん：

もう１つ参考までに。

↑で、オブジェクト（今回はシート）を短めの変数に格納して参照、
あるいは　With オブジェクト　でくくり、以降ピリオドをつけて
.オブジェクトとして参照する利点を、コードがすっきりするとコメントしましたが
加えて、重要な利点があります。

たとえばコードで

SHeets("Sheet1").Range(なんたら) と参照すると、コードごとに、
そのシートオブジェクトをさがしに行きます。
一方、変数.Range(なんたら) や .Range(なんたら) と記述すると
シートオブジェクトをピンポイントで直接参照しますので、処理効率がアップします。

・ツリー全体表示


	【77694】Re:お願いします

独覚 - 15/11/30(月) 10:48 -


	引用なし

	パスワード

しかも前回は知恵袋のExcelカテゴリで質問していたが今回は数学カテゴリと英語カテゴリの
二つに全く同じ質問文で…

・ツリー全体表示


	【77693】Re:お願いします

独覚 - 15/11/30(月) 10:40 -


	引用なし

	パスワード

▼arusu さん：
一度回答を書き込みましたがこのサイトのマルチポストを行いたい場合の方法
（マルチポストしているサイトを明記する）
に従っていないこと、個人的にマルチポストには回答したくないこと、質問文もコピー
（「以前にこの質問をした」ということなので、この掲示板で「arusu」を検索したがなかったので
ハンドル名を変えているのかと思ったら以前に知恵袋で質問していたようだ）
なので回答を削除しました。

・ツリー全体表示


	【77692】Re:ｌｚｈを解凍する際、入っていたフォ...

γ - 15/11/30(月) 7:16 -


	引用なし

	パスワード

UnlhaFindFirst や UnlhaFindNext というAPIを用いて
ファイル名を取得することができるかもしれませんね。
宣言方法などは、
ht tp://keep-on.com/excelyou/2001lng4/200101/01010096.txt
を参照してみてはいかがでしょうか。

# コメントしても無視する輩がいて気分が悪い。

・ツリー全体表示


	【77691】Re:無限ループから他のマクロへの分岐

茶ー坊 - 15/11/30(月) 0:49 -


	引用なし

	パスワード

▼β さん：
有難うございました　書かれていることの内容はまだ完全には理解できてませんが
思い通りに動いてくれました　now()関数を　セルに書いておいて　このマクロを走らせると　刻々と時刻が動いてくれました　そう上で　Proc1 Proc2　StopLoop で終了しました　・・・・　素早いご回答ありがとうございました。

・ツリー全体表示


	【77690】Re:無限ループから他のマクルへの分岐

β - 15/11/29(日) 22:34 -


	引用なし

	パスワード

▼茶―坊さん：

γさんの回答を拝見して、あぁ、そうだと。
何も、βがアップしたような、とってつけたようなコード処理は不要でしたね。

以下のようなコードにして、ChangeStatusに　たとえば　ショートカットキー a、
StopLoop に　ショートカットキー z を割り振っておけば、Ctrl/a で　Proc1 と Proc2 の切り替え。
Ctrl/z で終了になりますね。

Dim flag As Boolean
Dim DoLoop As Boolean

Sub test()
　　DoLoop = True
　　flag = True
　　Do
　　　　If flag Then
　　　　　　proc1
　　　　Else
　　　　　　Proc2
　　　　End If
　　　　
　　　　DoEvents
　　　　
　　Loop While DoLoop
　　
　　Range("A1").Value = "終了"
　　
End Sub

Sub proc1()
　　Range("A1").Value = 1
End Sub

Sub Proc2()
　　Range("A1").Value = 2
End Sub

Sub ChangeStatus()　'Ctrl/a
　　flag = Not flag
End Sub

Sub StopLoop()
　　DoLoop = False　'Ctrl/z
End Sub

・ツリー全体表示


	【77689】Re:ｌｚｈを解凍する際、入っていたフォ...

ペンネーム船長 - 15/11/29(日) 22:05 -


	引用なし

	パスワード

▼γ さん：
>後半部分は単なる思いつきです。
>別の方からAPIを利用したもっと良い案が出ると思いますので、
>いったんペンディングにしておいて下さい。

lzhがＡフォルダーの中にあるときの解凍方法は調べて試してみたのですが、
これは私のやりたいことには未だ遠く及びません。

'DLLを使う事を宣言する
Private Declare Function Unlha Lib "UNLHA32.DLL" (ByVal Callhwnd As Long, ByVal LHACommand As String, ByVal RetBuff As String, ByVal RetBuffSize As Long) As Long
　　
Private Sub CommandButton1_Click()

'********* UnLHA32.DLLを使ってLZHファイルを解凍する *********
Dim Ret As String * 255　　　　　　　'UnLHAからの結果を入れるバッファ（長さ255バイト）
Dim SendStr As String　　　　　　　　'コマンドﾞ文字列
Dim sourceFile As String　　　　　　 '解凍する圧縮ファイル
Dim targetDir As String　　　　　　　'解凍先ディレクトリ
Dim Result As Long　　　　　　　　　 '戻り値
Dim Msg1 As String
Dim oFolder As Object
　　　　　　　　　　
targetDir = "C:\Temp\B" & "\"　　　　　　'初期値は同じディレクトリに解凍。
sourceFile = "C:\Temp\A" & "\" & "*.lzh"　'もうこの辺からお手上げ
SendStr = "e " & sourceFile & " " & targetDir
　　　　　　　　　'（スペースで区切っていることに注意）
　　　　　　　　　　　　　　　　
Result = Unlha(0, SendStr, Ret, 255)　　　　　　'UnLHA実行!
　　　　　　　
End Sub

・ツリー全体表示


	【77688】Re:ｌｚｈを解凍する際、入っていたフォ...

γ - 15/11/29(日) 20:43 -


	引用なし

	パスワード

後半部分は単なる思いつきです。
別の方からAPIを利用したもっと良い案が出ると思いますので、
いったんペンディングにしておいて下さい。

・ツリー全体表示


	【77687】Re:ｌｚｈを解凍する際、入っていたフォ...

γ - 15/11/29(日) 20:11 -


	引用なし

	パスワード

すみませんが、今できているところまで示してもらえますか？

ファイルの更新年月日は古いままでしょうから、
基本的なアイデアとしては、
・解凍先のフォルダのファイル名を予め保持しておいて、
・解凍後に増えたファイルを対象として、名前を書き換える
ことを実行すればいいんじゃないでしょうか。

・ツリー全体表示


	【77686】ｌｚｈを解凍する際、入っていたフォルダ...

ペンネーム船長 - 15/11/29(日) 19:23 -


	引用なし

	パスワード

Ａフォルダーの中にア・フォルダー、イ・フォルダ－、ウ・フォルダー等多数があります。
ア・フォルダ-の中には、圧縮ファイル「※.lzh」があります。イやウのフォルダーも同じ名前の「.lzh」が入っています。
「.lzh」は○○.csv、□□.xls、△△.pdfを圧縮したものです。
「.lzh」はＢフォルダーに解凍します。
解凍にはＵＮＬＨＡ３２．ＤＬＬを使います。
教えて欲しい内容：
ア、イ、ウ・・・フォルダーの中にある「.lzh」を解凍した際、csv、xls、pdf名の頭にフォルダー名（ア、イ、ウ・・・）を付けてＢフォルダーに置くコードを教えて下さい。
Ｂフォルダーにはア○○.csv、ア□□.xls、ア△△.pdf、イ○○.csv、イ□□.xls、イ△△.pdf、ウ○○.csv、ウ□□.xls、ウ△△.pdf・・・が置かれるようにしたいのです。
宜しくお願いします。

・ツリー全体表示


	【77685】Re:VBAを使い、別シートにデータを抽出し...

たけちゃんまん - 15/11/29(日) 11:54 -


	引用なし

	パスワード

βさま

お礼が遅くなり、申し訳ありません。

詳しく解説して下さり、ありがとうございます！
日頃からフィルターは使用しておりますが、ほんの一部しか使いこなせておりませんので、オートフィルター及びフィルターオプションについて、学ばせて頂きます。

明日、実行しながら学習させて頂き、結果をご報告させて頂きます。

・ツリー全体表示


	【77684】Re:無限ループから他のマクルへの分岐

β - 15/11/28(土) 22:54 -


	引用なし

	パスワード

▼茶―坊さん：

いまいち要件が分からないのですが、たとえば以下のコードは
最初 Proc1 が実行されます。
で、→キーをおすと Proc2 の実行に変わります。
←キーをおすと Proc1 の実行になります。
何度でも切り替えはできますが、Shiftキーを押すことで終了します。
Shiftキーは長めに押してください。

Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub Test()
　　Dim rtn As Long
　　Dim flag As Boolean
　　
　　flag = True
　　
　　Do
　　
　　　　rtn = GetAsyncKeyState(vbKeyShift)
　　　　rtn = rtn And &H80000000
　　　　If rtn <> 0 Then Exit Do
　　　　rtn = GetAsyncKeyState(vbKeyRight)
　　　　rtn = rtn And &H80000000
　　　　If rtn <> 0 Then flag = False
　　　　rtn = GetAsyncKeyState(vbKeyLeft)
　　　　rtn = rtn And &H80000000
　　　　If rtn <> 0 Then flag = True
　　　　
　　　　If flag Then
　　　　　　Proc1
　　　　Else
　　　　　　Proc2
　　　　End If
　　　　
　　　　DoEvents
　　　　
　　Loop
　　
　　Range("A1").Value = "終了"
　　
End Sub

Sub Proc1()
　　Range("A1").Value = 1
End Sub

Sub Proc2()
　　Range("A1").Value = 2
End Sub

・ツリー全体表示


	【77682】無限ループから他のマクルへの分岐

茶―坊 - 15/11/28(土) 21:00 -


	引用なし

	パスワード

マクロ初心者です
　Sub　macro1()

　 for i=1 to 10

　　 Caluculate(再計算)

　　****************

　 if i=10 then i=1

　 next

　End Sub

極端な例ですが　こんなループから
　　　　**********
のところで他の　Ctrl＋Aとかで　他のマクロに分岐したいのですが　
車がある速度で走っているときの　刻々の　走行距離を表示し
途中で速度を変えたりするマクロを実行したいのですが
　如何でしょうか、よろしくお願いいたします

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

237 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free