常連

注目の的

社会貢献

回答者

自己紹介

有名人

### 前提・実現したいこと

excelから安全にメールを送りたいのですが以下のサイトの方法を取っても
ログインの手前で止まってしまいます。
https://www.ka-net.org/blog/?p=4524

apiの画面もこの頃と変わっているようで上手くいきませんでした。
解決策が分かる方もしくはgmailのセキュリティーを落とさずにCDOを使う方法を知っている方が居れば教えて下さい。
フリーのソフトを使えばいいであるとか他のソフトを使えばと言う人が居ますがそう言う助言は正直いらないので書かないで下さい。

Gmail apiを使用したエクセルからのメール添付もしくはセキュリティーを落とさないCDO

お世話になっています。
今回はDllの事で質問させてください。

### 要件
アプリケーションを設計・開発している際に、追加要件が発生することは多々あると思います。
その際にプログラムに直接追加するよりも、既存のDllファイルを使って解決する方法がありますが、そのプログラムをクライアントに簡単に配布する方法はありますでしょうか？

### 環境
環境：VB6、VisualStudio2017
アプリケーション側の言語：VB、VBA
Dll側の言語：C、C++、VB

### 追記
・インストーラは使わない方針です。
クライアント側に委ねる形でなく、複数台のクライアントにサイレント修正できるような方法を探しています。
一番の理想は、クライアントに置いてるアプリケーションと同じ階層にDllファイルを置くだけで解決するような方法です。
・作業するのは自分です。
コピーするだけで済むなら良いのですが、VB6の環境がないクライアントもあり、「Dllの参照設定」ができないせいでDllが使えません。
Dllの参照設定を行った端末では問題なく動きましたが、そうでない端末では動きませんでした。
・https://qiita.com/mmYYmmdd/items/fc1d3cce6a39771c0f36
上記のアドレスを参考にしたのですが、Dllの内部が公開されていなかったため再現できませんでした。
・試したこと
Dllをアプリケーションと同じ階層に配置し、以下のようにコールしています
```VB
Private Declare Function ADD Lib "D:\YobidasiExe\DLLTEST01.dll" (a As Long, b As Long) As Long

Private Sub CommandButton1_Click()
    Cells(1, 2) = ADD(1, 1)
End Sub
```
Dll側は以下のようになっています
```C++
#include "stdafx.h"
#include <windows.h> 

void __stdcall DLL_TEST1()
{
	MessageBox(NULL, "DLL呼び出し成功！", "test", MB_OK);
	Beep(523, 200);
}

int __stdcall ADD(int a, int b)
{
	return a + b;
}
```
Dllで利用しているライブラリはないです。

・テストについて
端末AでC++を使ってDLLを作成し、同端末上VBAでDLLを呼び出すことは成功しました。
しかし端末BにDLLとExcelをコピーペーストして起動しても、DLLを呼び出すことはできませんでした。

Dllファイルの追加配布は簡単にできるのか？

###最終　--2018.11.16 13:40　追記 --
回避策...
手動、マクロ 問わずに 大量のセルに対し操作の必要があるときは
「カメラ」機能や リンクされた図は使用しない
又は、
一度閉じると使用メモリが元に戻るので
目視、又はpowershell 等を用いて使用メモリが一定量を超えたら
Excelプロセスを再起動してから作業を続行する...

「カメラ」機能や リンクされた図は使用しない のが王道でしょうか
他にも不具合がいっぱいあるようですし
便利な機能なのでとても残念です.....


###現在の状況　--2018.11.16 11:35　追記 --
sazi 様 からのコメントで分かったのですが
カメラ機能でなくても
貼り付けオプションの「リンクされた図」でも
同様の症状が出ることが分かりました。

###現在の状況　--2018.11.16 11:20　追記 --
検証を重ねた結果
メモリの上昇量には一応上限があることが分かりました。
カメラの範囲の他
入力されている数式の数 計算量?
等に影響されることが分かりました。
Win10 Excel 2013 32bit でも確認しました。

###現在の状況　--2018.11.16 10:40　追記 --
原因の特定が出来ました。
Excelの 「カメラ」機能を使用して作成したオブジェクトが存在すると
本文記載の問題が発生するようです。

Win10 Excel 2016 64bit で
新規ブックのみを立ち上げ確認致しました。

そのオブジェクトは
0. 適当なセル10個ほど選択
0. 「カメラ」をクリック
0. 適当なセルクリック
で配置しました。

出来れば引き続き「カメラ」機能は使いたいのですが
回避方法はないのでしょうか?
また、症状の再現が出来た方、出来なかった方
環境を教えて頂きたいです。
お願い致します。

「カメラ」機能はクイックアクセスツールバーに追加して利用しました。

![イメージ説明](4d3ba88410469581ee509816d367208c.png)
![イメージ説明](d8e4949cf16bf1a3c497738682c29978.png)


###現在の状況　--2018.11.16 09:47　追記 --
いろいろ検証をした結果
コードだけに問題があるわけではなく
 Excelファイルが異常をきたしている のか 
特定条件下のでの Excelの挙動が問題になっている可能性が高いことが分かりました。

発生している 症状は

特定のブックを開いている状態で同じプロセス内の任意のブックの任意の
セルの設定(塗りつぶし、ユーザー定義書式 等)を書き換えるだけで
その都度 使用メモリが増加する。

手動で適当なブックの適当なセルを選択してセルの塗りつぶしボタンを連打するだけでも同様に発生

特定のブックは開かず 新規のブックのみ開いて手動でセルの塗りつぶしボタンを連打しても
使用メモリは 増加しますが
おそらく 戻るボタンの 履歴の関係だと思うのですが　そちらは一定以上は上がりません。

特定のブックを開いていると下記のコードを実行しただけでメモリ不足のエラーが表示されます。
```vba
Sub test()

    Dim i As Integer
    For i = 1 To 10000
        Selection.NumberFormat = Selection.NumberFormat
    Next i
End Sub
```
他気になる点は
上記コード実行時はExcelのCPU 使用率が10％強 くらいまでしか上がらず
(未保存新規ブックのみ起動の場合は30%くらいまで使用率が上がり、すぐ終わる)
実行速度が極端に低下することです。

現在 状況を再現できないか確認しています。



### 前提・実現したいこと
発端は
Excel ブック(ファイル)に問題があるのか頻繁にデータが壊れて
修復しますか?と表示される。
修復を選択すると開けるが セル幅 が全て同じ幅になってしまったりして　まともに修復できていない。
そんな状態を何とかしたい...
過去に同様の現象が起きたときはブックを新規作成(シートをコピーしたらだめだった)して作り直したら再発しなくなったので、
そうしようと思ったのですが量が多い...

そのためマクロで書式設定等を移してしまおうと思ったのですが
メモリが不足していますと表示されて途中までしか実行できません。

**メモリが不足と表示されてしまう**原因が全く分からず
今回はいつこの問題が解決できるかもわからないので諦めて手動で作り直そうかと思うのですが、
今後の対策のためにも**原因が知りたい**です。

極力コードを削って確認してみたのですが
Get_Set_CellInfo 内の 塗りつぶし　や　削ったため下記のコードにはないですが
罫線の設定、ユーザー定義書式の設定などでも同様にメモリ不足と表示されます。

タスクマネージャで見てみたのですが　パソコン全体のメモリは余裕があるようでした...

### 発生している問題・エラーメッセージ

![![イメージ説明](bf6b58ce573e0c9e4bc1d2247c658404.png)
### 該当のソースコード


Book1の全ての使用済みセルに対しての処理
処理は結合範囲ごと(セルをひとつずつ確認して結合セル範囲の左上だった時のみ)



```vba

Sub SHC()

    Const BaseNm As String = "Book1.xlsx"
    Const TargetNm As String = "Book2.xlsx"
    
    Dim Base As Workbook
    Set Base = Workbooks(BaseNm)
    
    Dim Target As Workbook
    Set Target = Workbooks(TargetNm)
    
    Dim BaseCt As Integer
    BaseCt = Base.Sheets.Count
    
    Dim i As Integer
    
    
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim Result As Variant
    
    For i = 1 To BaseCt
    Debug.Print i
        Get_Set_CellJoin Base.Sheets(i), Target.Sheets(i)
    Next i
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Sub Get_Set_CellInfo(BRng As Range, TRng As Range)

    If BRng.MergeCells Then
        TRng.Merge
    End If

' 塗りつぶし
    TRng.Interior.Pattern = BRng.Interior.Pattern
    If Not BRng.Interior.Pattern = xlNone Then
        TRng.Interior.Color = BRng.Interior.Color
    End If

End Sub


Sub Get_Set_CellJoin(BSh As Worksheet, SSh As Worksheet)
'セルの書式

    Dim Rng As Range
    Set Rng = BSh.UsedRange
    
    Dim Row As Long
    Row = Rng.Rows.Count
    
    Dim Col As Long
    Col = Rng.Columns.Count
    
    Dim R As Long
    Dim C As Long
    
    Dim TCell As Variant
    
    For R = 1 To Row
        For C = 1 To Col
            
            If Rng(R, C).Address(False, False) = Rng(R, C).MergeArea(1, 1).Address(False, False) Then
                Debug.Print Rng(R, C).MergeArea.Address(False, False)
                Get_Set_CellInfo Rng(R, C).MergeArea, SSh.Range(Rng(R, C).MergeArea.Address(False, False))
            End If
            
        Next C
    Next R
    
End Sub
```

### 試したこと

For each で回しているのが悪いのかと思いfor に書き直してみた
途中でブックの保存を挟んでみた
Set を使っているものに対しては各プロシージャの最後で　set 変数 = nothing をしてみた
パソコンを再起動してみた
ステップインで一つずつステートメントを実行してみた
罫線等の設定でも同様になる

--追記--
mdj　様の「1シート処理するように書き換えてみて、検証するのはどうでしょうか。」の言葉で
目的のブック以外に同様の操作をした場合に同じ現象が起きるかどうかの検証をしていないことに気づいたので、
**容量が多い別のファイル(数式は殆ど入っていない)で　検証をした結果
そちらでは同様の問題は発生しませんでした。**


--追記--
プログラムエラーとは別に 新規作成から作り直していたExcelブックの件で、
7時間くらいかけてなんとか 元のブックと見分けがつかないくらいまで作ったのですが
2018.11.15 現在 壊れているのを確認しました....

仮定していた「長年(拡張子が .xls だったころから)使ってきたので
ブックのどこかがおかしくなっていて壊れやすくなっている」という可能性が低くなりました。

「代わりに特定条件下で壊れやすくなっている」可能性が 高くなったので
プログラムエラーの件と合わせて**再現可能か確認**してみます。

他のブックとの違いといえば 他のブックへの参照 と 他のブックからの参照 があり
尚且つ そのデータを使ったグラフがある事くらいだと思うのですが...

--追記--
見かけそっくりに作り直した方のデータ(一度壊れて再び修復中のためグラフがない　あと他ブックへのリンクが切れているかも...)に対しては
使用メモリが増え続ける現象は起きませんでした。

--追記--
メモリがパンクする前に中断した場合 そのExcelプロセスを閉じるまで(ブックを閉じても)メモリはそのままでした。
開きなおすと 増加してしまった使用メモリは元に戻っていました。

問題のブックのセル設定の読み込みのみ(variant 変数への代入)のみ行った場合は使用メモリの増加は発生しませんでした。

問題のブックを開いた状態で 同じプロセス上の関係のないブックのセルの設定を書き換えて見たら 使用メモリの増加が発生しました。

どうやら　問題のブックを開いている状態で同じプロセス内のブックのセルの設定を書き換えるだけで
使用メモリが増加してしまうようです。

--追記-- 
問題のブックを開いている場合
手動で適当なブックの適当なセルを選択してセルの塗りつぶしボタンを連打するだけでも
使用メモリが増加することが 確認できました....

問題のブックは開かず 新規のブックのみ開いて同様の内容を行っても
使用メモリは 増加しますが
一定以上は上がりません。

そちらはおそらく履歴(戻るボタンで戻るための分)で増えただけだと思われます。


### 補足情報（FW/ツールのバージョンなど）

Win10
Excel 2016 64bit

Book1の情報
拡張子 xlsx
ファイルサイズ　112 KB
各シートのUsedRange
シートインデックス = 1 : 行数 = 57 : 列数 = 54
シートインデックス = 2 : 行数 = 36 : 列数 = 73
シートインデックス = 3 : 行数 = 34 : 列数 = 73
シートインデックス = 4 : 行数 = 34 : 列数 = 73
シートインデックス = 5 : 行数 = 57 : 列数 = 11
シートインデックス = 6 : 行数 = 40 : 列数 = 22
シートインデックス = 7 : 行数 = 31 : 列数 = 15
シートインデックス = 8 : 行数 = 20 : 列数 = 18

グラフ1(折れ線グラフ)
数式多数 使用　(他のブックへの参照と他のブックからの参照多々あり)

Excel vba でメモリが不足しています。っと表示されて処理が完了できない。

ドキュメント内に配置した画像やシェイプを別のファイルのフッターにコピーしたいと
考えております。（シェイプは規定のものがあり、新たに作成したくない）

手始めに自ドキュメントのフッターへのコピーの為、以下を試しましたが、
word自体がエラーして停止してしまうようです。

```vba
Sub test()

ActiveDocument.Shapes("img").Select
Selection.Copy
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Select
Selection.PasteAndFormat (wdPasteDefault)

End sub
```

また、以下の方法も試しましたが、すでにドキュメント内にあるシェイプを指定する方法が
分かりませんでした。

インストラクターのネタ帳 様
https://www.relief.jp/docs/word-vba-add-shape-header.html

```vba

sub test2()

  Dim shp As Shape

  Set shp = _
    ActiveDocument _
        .Sections(1).Footers(wdHeaderFooterPrimary) _
        .Shapes.AddPicture( _
            fileName:="C:\Users\img.png", _
            Left:=5, Top:=5, _
            Width:=100, Height:=50)

End sub

```

ご教示の程、よろしくお願いいたします。

【word VBA】ドキュメント内の画像・シェイプをフッターにコピー

### 前提・実現したいこと

ExcelのシートのA列に伝票番号が列挙されています。
この伝票番号を、社内Webの伝票番号を登録するページに登録させるマクロを書きました。
IEで登録ページはもう開いておいて、そのページを見つけて捕まえて、順に伝票番号を入力して登録するような手順です。
IEのページを見つけるのは三流君とかの記事を見て学びました。
登録ページは、1件ずつ伝票番号をテキストボックスに入力して、登録ボタンを押すようになっています。

```VBA
    Dim sh As Object                '起動中のShellWindow一式を格納する
    Dim win As Object               '各ShellWindowを格納する
    Dim ie As InternetExplorer      'ShellWindowから見つけたIEを格納する
    Dim document_title As String    'IEのドキュメントタイトルを格納する
    Dim inputbutton As HTMLAnchorElement    'ボタンとかを探すときに要素を格納する
    Dim i As Long                   'イテレータ
    Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行
    
   
    '*-- 起動中のShellWindow一式を変数shに格納 --*
    Set sh = CreateObject("Shell.Application")
    
    For Each win In sh.Windows
        'ドキュメントタイトル取得失敗を無視（処理継続）--*
        On Error Resume Next
    
        If TypeName(win.document) = "HTMLDocument" Then
            document_title = ""
            document_title = win.document.Title
            On Error GoTo 0
                    
            '*-- ページのタイトルで探す --*
            Set ie = win
            If InStr(document_title, "伝票番号入力") > 0 Then
            
                '*-- シートの伝票番号の数だけ繰り返す --*
                For i = 1 To endRow Step 1
                    '*-- 伝票番号を入れて登録ボタンを押す --*
                    ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
                    For Each inputbutton In ie.document.getElementsByTagName("input")
                        If inputbutton.Value = "登録" Then
                            inputbutton.Click
                            Exit For
                        End If
                    Next
                    Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
                        DoEvents
                    Loop
                Next i
                Exit For
            Else
                '*-- 画面を閉じる(登録画面以外のIE) --*
                ie.Quit
            End If
        End If
    Next

    '*-- いろいろ解放 --*
    Set sh = Nothing
    Set ie = Nothing
```

### 発生している問題・エラーメッセージ

バカみたいにいっぱいIEを立ち上げてる人がいて（ウィンドウを開いたら開きっぱなしで閉じないスタイル）
なので伝票登録のこれ動作時に、同じ名前のウィンドウが複数開いていると、目的のと違うウィンドウを捕まえてしまうことが多く……

なので、これを動かす前に、この伝票番号入力ページが複数開いていたら
「開いてますよ！」と怒ったうえでこれの処理はしない、というようにしたいのですが
複数開いています、というのをどうやったらいいのか思いつきません。
「起動中のShellWindow一式を変数shに格納」の後に
```VBA
    cntPage = 0
    For Each win In sh.Windows
        'ドキュメントタイトル取得失敗を無視（処理継続）--*
        On Error Resume Next
    
        If TypeName(win.document) = "HTMLDocument" Then
            document_title = ""
            document_title = win.document.Title
            On Error GoTo 0
                    
            '*-- ページのタイトルを数える --*
            Set ie = win
            If InStr(document_title, "伝票番号入力") > 0 Then
                cntPage=cntPage + 1
            End If
        End If
    Next
    If cntPage <> 1 then
        MsgBox "IEは目的の1枚だけ開いておいてあとは閉じてください"
        Exit Sub
    End If
```
みたいなのを書けばよいのでしょうか。
同じようなコードが2回来るのってみっともなくないでしょうか。

### 補足情報（FW/ツールのバージョンなど）

Win10、Excel2016、IE11です。

###追加1
皆様ありがとうございます！
教えていただいた内容を踏まえて、関数にしてみました。
```VBA
Sub entryDenpyo()

    Dim sh As Object                '起動中のShellWindow一式を格納する
    Dim win As New Collection       '各ShellWindowを格納する
    Dim ie As InternetExplorer      'ShellWindowから見つけたIEを格納する
    Dim document_title As String    'IEのドキュメントタイトルを格納する
    Dim inputbutton As HTMLAnchorElement    'ボタンとかを探すときに要素を格納する
    Dim i As Long                   'イテレータ
    Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行


    '*-- 起動中のShellWindow一式を変数shに格納 --*
    Set sh = CreateObject("Shell.Application")

    '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --*
    Set win = FindPages(sh,"伝票番号入力")
    If win.Count = 1 Then
        Set ie = win(1)
    Else
        MsgBox ("伝票番号入力画面を1個だけ開いて、あとは閉じてください。")
        Exit Sub
    End If

    '*-- シートの伝票番号の数だけ繰り返す --*
    For i = 1 To endRow Step 1
    	'*-- 伝票番号を入れて登録ボタンを押す --*
        ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
        For Each inputbutton In ie.document.getElementsByTagName("input")
            If inputbutton.Value = "登録" Then
                inputbutton.Click
                Exit For
            End If
        Next
        Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
    Next i

    '*-- いろいろ解放 --*
    Set sh = Nothing
    Set ie = Nothing

End Sub

'*-- 開いているIEのページをcollectionに入れて戻す --*
Function FindPages(ByVal shs As Object,ByVal pagetitle as string) As Collection

    Dim win As Object               '各ShellWindowを格納する
    Dim document_title As String    'IEのドキュメントタイトルを格納する
    Dim ie As InternetExplorer      'ShellWindowから見つけたIEを格納する
    Dim clIE As New Collection      'コレクション格納用	

    For Each win In shs.Windows
        'ドキュメントタイトル取得失敗を無視（処理継続）--*
        On Error Resume Next
    
        If TypeName(win.document) = "HTMLDocument" Then
            document_title = ""
            document_title = win.document.Title
            On Error GoTo 0
                    
            '*-- タイトルで探す --*
            Set ie = win
            If InStr(document_title, pagetitle) > 0 Then
                clIE.Add ie '合致したページをコレクションに格納
                Set FindPages = clIE
            End If
        End If
    Next

End Function
```
ここまで書いてから、h.horikoshiさんの回答を見て
「目的のページ1枚だけを戻すほうがいいっぽい…」
ということに気づきましたので、もういっかい考えます。

###追加2(できた！)
```VBA
Sub entryDenpyo()

    Dim sh As Object                        '起動中のShellWindow一式を格納する
    Dim ie As InternetExplorer              'FindPages関数で見つけたIEを格納する
    Dim inputbutton As HTMLAnchorElement    'ボタンとかを探すときに要素を格納する
    Dim i As Long                           'イテレータ
    Dim endRow As Long: endRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'Sheet1の最終行


    '*-- 起動中のShellWindow一式を変数shに格納 --*
    Set sh = CreateObject("Shell.Application")

    '*-- IEで開かれている[伝票番号入力]ページを探す、1個だけ開かれてるんじゃなかったら処理はしない。 --*
    Set ie = FindPages(sh,"伝票番号入力")

    If (Not (ie Is Nothing)) Then
        '*-- シートの伝票番号の数だけ繰り返す --*
        For i = 1 To endRow Step 1
            '*-- 伝票番号を入れて登録ボタンを押す --*
            ie.document.getElementsByName("denpyoNo")(0).Value = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
            For Each inputbutton In ie.document.getElementsByTagName("input")
                If inputbutton.Value = "登録" Then
                    inputbutton.Click
                    Exit For
                End If
            Next
            Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
                DoEvents
            Loop
        Next i
    else
        MsgBox "登録画面がみつかりません！"
    End If

    '*-- いろいろ解放 --*
    Set sh = Nothing
    Set ie = Nothing
    MsgBox "おわりました"

End Sub

'*-- 開いているIEのページを目的の1個だけ戻す。ページがなかったり複数だったりしたらNothingを戻す。 --*
Function FindPages(ByVal shs As Object, ByVal pagetitle As String) As InternetExplorer

    Dim win As Object               '各ShellWindowを格納する
    Dim document_title As String    'IEのドキュメントタイトルを格納する
    Dim ie As InternetExplorer      'ShellWindowから見つけたIEを格納する

    Set FindPages = Nothing
    For Each win In shs.Windows
        'ドキュメントタイトル取得失敗を無視（処理継続）--*
        On Error Resume Next
    
        If TypeName(win.document) = "HTMLDocument" Then
            document_title = ""
            document_title = win.document.Title
            On Error GoTo 0
                    
            '*-- IEだったらタイトルで探す --*
            Set ie = win
            If InStr(document_title, pagetitle) > 0 Then
                If FindPages Is Nothing Then
                    Set FindPages = ie
                Else
                    MsgBox pagetitle & ("画面を1個だけ開いて、あとは閉じてください。")
                    Set FindPages = Nothing
                    Exit Function
                End If
            End If
        End If
    Next

End Function
```
皆様のご指導のもとに、とても改善して書けました！
「開いているIEのページを目的の1個だけ戻す」というのは
他にも1件ずつエントリするような作業がいろいろありますので（社内システムがイケてないので……）
この部分を関数にできたので、使いまわせそうな気がします。

ベストアンサーっていっぱいつけられないのですね……
teratailは先生がいっぱいいるので嬉しいです！ありがとうございます。

同じ名前のページは1枚だけ開いていてほしい

Excel2007を利用しています。
ExcelのVBAで、WinSCPのSFTPで接続しているパスを取得したいと思っています。

セッションの設定
⇒転送プロトコル　SFTP
　ホスト名（あり）　ポート番号（あり）
　ユーザー名（あり）　パスワード（あり）
コマンドでFTP接続？等色々試しましたが、上手く接続出来ませんでした。


Excelで利用するのは、ファイルのパスをExcelに記載する必要があるためです。
フルパスを記載する必要があるのですが、その人が利用したいものを作成するために
毎回参照先が変わります（フォルダ作成をしたり、画像まで参照したりもします）
その人が利用する全てのパスをExcelに記載したいのです。

ただ、他の人はWinSCPを利用していません。
UWSCのプログラムで無理やり同じ状況になるように設定するか
パスを取得するか等　他の手段が欲しいと思っています。

Excelには、以下のようなデータが入っています。
番号,内容,説明文,テキストリンク,HTMLリンク,画像リンク,動画リンク,図表リンク
1,AがB,AがBな件について,サーバーのXXX.txt,サーバーのXXX.html,サーバーのXXX.jpeg,サーバーのXXXX.mp4,サーバーのXXX.jpg

上記、サーバーのXXX.txt等のファイルは自分のExcelファイルが置いてあるフォルダに置いてあります。
（または、フォルダ名でまとめています）
それをそのまま指定したサーバーに載せてサーバーのアドレスを取得したいです。

やっぱり、WinSCPでないと出来ないでしょうか？
Windowsのコマンド（バッチファイル）またはUWSCで
サーバーとファイル転送ができたら一番良いのですが…。
ソフトをインストールしないで何か方法ありませんか？

よろしくお願いいたします。

WinSCP等ソフトをインストールせず、サーバーとSFTPファイル転送がしたい（コマンド or VBA or UWSC)

Excel 2010 を使っています。こいつをWebサーバにできたりしないでしょうか。

旧態依然のいわゆるSIerではExcel台帳管理が横行しているのですが、ExcelマクロでWebサーバを作ることがもし可能なら、Webブラウザ経由でExcel台帳を更新できたりするのではないか、と考えています。
すこし調べたところ、VBA自体にはそのような機能がなさそうで、なんらかのDLLを利用し、ActiveXObject? として動かすことになるかなーと考えているところですが、そういったことに使えるMS標準的位置づけのDLLはあったりするものでしょうか。

excel as WebServer のようなキーワードで検索してみたのですが、先行事例はまだ見つけられていません。

ExcelをWebサーバにしたい

###Excel2010のVBAにて別Bookを開きたい
Windows~~10~~7(32bit)、Excel2010の環境にて
ExcelVBAにて別のBookを開く際にエラーが出て
Bookを開くことが出来ない

追記
Excel2010 Version14.0.7015.1000（32ビット）
開こうとしているBookに関して
・.xlsxファイル(このファイルを生成したExcelのVersionは不明）
・シート数30弱
・マクロ等はしこまれていない

###発生している問題・エラーメッセージ

特定のPCでのみで発生しており
他のPCではエラーは発生せずに正常稼動している

エラーの出ている特定のPCでも10月時点では動作を確認しており
11月中旬あたりで下記のエラーが出るようになった
エラーが発生している特定のPCが手元に無いため
10月～11月中旬ごろの間に、どのような変更があったかは不明

エラー番号:1004
エラー内容:WorkbooksクラスのOpenプロパティを取得できません

###該当のソースコード
```VBA
Dim xlapp As Variant
Set xlapp = CreateObject("excel.application")
xlapp.Visible = False

'ファイルの存在チェック
If Dir(filepath) = "" Then
　　　GoTo Continue
End If

Set xlbooks = xlapp.Workbooks
’ここでエラーが発生
Set work_book = xlbooks.Open(filepath, ReadOnly:=True)
```


###試したこと
下記のことを試しても改善、及び現象の再現はしていない状況です

1.別Verのエクセルが導入された可能性を見越してExcelのVerをチェック
```VBA
If xlapp.Version <> 14# Then
    Dim old_ver As Double
    old_ver = xlapp.Version
    xlapp.Quit
    MsgBox "ExcelVer切り替え:" & old_ver
    Set xlapp = CreateObject("excel.application.14")
    Call m_output_log.output_log("ExcelVer切り替え:" & old_ver)
End If
```

2.開こうとしているBookが他のアプリで使用されている可能性を見越してコピーをとり、コピーしたファイルを開く

3.開こうとしているBookのアクセス権限を変更する

4.負荷テストとしてExcelのプロセスを50個ほど立ち上げる

5.負荷テストとして、別アプリにて物理メモリを食いつぶしてみる

6.CreateObjectを使用せずに下記のコードでのOpen
```VBA
    Set work_book = Workbooks.Open(report_file, ReadOnly:=True)
```
###補足情報
特定のPCで使用しているファイルを別PCにコピーして実行してもエラーが出ない為
特定PCの環境依存の問題かと思われます

拙い文章かつ少ない情報ですが
お心当たりのある方、アドバイスをいただければ幸いです

WorkbooksクラスのOpenプロパティを取得できません

![イメージ説明](0bcaf7c6b1cf23f31cbb0cc1c1a6740c.png)

上記のイメージ図において、
AならAのみでMarge、BならBのみでMargeする
記載方法方法を教えてください。

VBAのMArge方法について

###前提・実現したいこと

複数営業所がある会社に勤めており、
Excel VBAで郵送されてきた請求書類の情報を
各営業所でエクセルに入力するシートを作成しています。
入力シートは簡易化していますが下記の請求情報を入力します。
・請求会社名（入力規則・リスト）
・取引内容（入力規則・リスト）
・勘定科目（自動設定）
・補助科目（自動設定）
・請求金額（手入力）

郵送されてくる請求書類は毎月同じところからくるため（例外もあるが）
入力規則でリスト選択をで基本する仕様にしています。
ただし、営業所によって届く請求書類は異なるので
入力シート：A1に営業所名のリストを作成し、変更することで
請求会社名と取引内容の入力規則をValidationで変更をかけています。

同フォルダ内に下の２ファイルを入れて、外部参照データは下表の様に作成し
営業所名が変更されると、請求会社名と取引内容の変更をかけ、
取引内容が変更されると、請求会社名と取引内容に応じた勘定科目・補助科目名を
拾ってくるようにしています。

・外部参照データ.xlsx（以降、外部参照データ）
・入力シート.xlsm（以降、入力シート）
請求会社名|取引内容|勘定科目|補助科目名|計上営業所
|:--:|:--:|:--:|:--:|:--:|
|A列|B列|C列|D列|E列|

文才が無いのでわかりずらいですが、これらの仕組み自体は無事でき、
動作もしているのですが、一部の営業所名にしたときだけエラーが発生してしまう状態です。

使用環境
・Windows7
・Excel 2013 64bit

###発生している問題・エラーメッセージ
エクセルを開いた直後に
```
「入力シート.xlsm」の一部の内容に問題が見つかりました。可能な限り内容を修復しますか？ブックの発行元が信頼できる場合は「はい」をクリックしてください。
```

###試したこと
問題が起きる営業所・起きない営業所があることから
入力規則へ入れ込むデータに異常があるのかなと考え
外部参照データで問題が起きる営業所の対象データだけに絞りこみ
例えば10行データあったとすると
1行だけ残し残り9行を削除し実行
問題なければ2行だけ残し、残りを削除し実行...のように
試していきましたがエラーは出たりでなかったりと、原因の追究にいたりませんでした。

私の頭では他に考えが浮かばず、
考え方自体がおかしいのかなと思い、今回質問をさせていただきました。

初歩的なことだったり、文章に不十分な点があったら大変申し訳ないのですが
教えていただけますでしょうか？
よろしくお願いいたします。

#追記

```Excel VBA
Option Explicit


Private Sub Worksheet_Change(ByVal TargetRange As Range)

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim Target As Range
    
    ml_set.setSheets
    arrLO = setCnvTable
    If TargetRange.Column <= 2 And TargetRange.row > 3 Then
        
'        セルを範囲指定していた場合のループ処理
        For Each Target In TargetRange

            Select Case Target.Column

                Case 1 '        相手先名が選択されたら
                    Call wsUnProtect
                    Target.Offset(, 1).Resize(, 4).ClearContents    '取引内容～金額（税込）までをクリア
                    Call setCellLocked(Target.Offset(, 4), False)   '金額（税込）のロック解除

                    Select Case Target.Value
                        Case ""   '相手先名が空白だった場合リセット
                            Target.Offset(, 1).Resize(, 12).ClearContents
                            With Target.Offset(, 1).validation
                                .Delete
                                .Add Type:=xlValidateList, _
                                    Operator:=xlEqual, _
                                    Formula1:="相手先名を設定してください"
                                    .InputMessage = "取引内容の先に相手先名を設定してください"
                                    .ShowError = False
                                    .ShowInput = True
                            End With
                    
                        Case Else    '相手先名が空白じゃなければ取引内容をセット
                            Call setTradeValidationRule(Target)
                            If Cells(1, 4) <> "本社" Then Target.Offset(, 7) = Cells(1, 4)
                        
                    End Select
                    Call wsProtect
        
                Case 2 '        取引内容が選択されたら
                
                    If Target.Offset(, -1) = "" Then    '相手先名が空だったら取引内容をリセット
                        Target.ClearContents
                        
                    Else
                        Select Case Target.Value
'                           取引内容を空にしたら、勘定科目～支払口座名（計上営業所を除く）までをリセットする
                            Case Is = ""
                                Call setCellLocked(Target.Offset(, 3), False)
                                Target.Offset(, 1).Resize(, 5).ClearContents
                                Target.Offset(, 7).Resize(, 4).ClearContents

'                           取引内容をセットしたら、勘定科目～金額・支払口座名をセットする
                            Case Else
                                Target.Offset(, 1).Resize(, 3).ClearContents
                                Call setSubjects(Target)
                                If Not IsEmpty(Target.Offset(, 3).Value) Or Target.Offset(, 3).Value > 0 Then
                                    Call setCellLocked(Target.Offset(, 3), True)
                                Else
                                    Call setCellLocked(Target.Offset(, 3), False)
                                End If
                                
                        End Select
                    End If
            End Select
        Next

    End If
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

Public Sub setTargetValidationRule()
'	請求先会社名の設定
'
    ReDim validation(0)
    
    Dim i1, i2, iX As Long
    Dim office, company As String
    
    office = wsInput.Cells(1, 4)
    company = wsInput.Cells(1, 2)
    
    For i1 = 2 To UBound(arrLO)
        If company = arrLO(i1, 8) And office = arrLO(i1, 5) And arrLO(i1, 9) <> "共通" Then
            For i2 = 0 To UBound(validation)
                If validation(i2) = arrLO(i1, 1) Then
                    Exit For
                ElseIf i2 = UBound(validation) Then
                    ReDim Preserve validation(iX)
                    validation(iX) = arrLO(i1, 1)
                    iX = iX + 1
                End If
            Next i2
        End If
    Next i1
    
    If iX > 0 Then
        Call setValidation(wsInput.Range("A4:A300"), validation, False)
    End If
End Sub

Public Sub setTradeValidationRule(Target As Range)
'	取引内容の設定    
    Dim validation()
    
    Dim i1 As Long
    Dim iX As Long
    
    Dim office As String
    office = wsInput.Cells(1, 4)
        
    For i1 = 2 To UBound(arrLO)
        If office = arrLO(i1, 5) And Target = arrLO(i1, 1) And Not IsEmpty(arrLO(i1, 2)) Then
            ReDim Preserve validation(iX)
            validation(iX) = arrLO(i1, 2)
            iX = iX + 1
        End If
    Next i1
    
    If iX > 0 Then
        Call setValidation(Target.Offset(, 1), validation, False)
    Else
        With Target.Offset(, 1).validation
                    .Delete
                    .Add xlValidateInputOnly
                    .InputMessage = "「" & Target + "」は、取引内容が設定されていません" + vbNewLine + "取引内容は直接入力をしてください"
                    .ShowInput = True
                    .IMEMode = xlIMEModeHiragana
        End With
    End If
End Sub

Public Sub setValidation(Target As Range, validation, isErr As Boolean)
'   入力規則リストの設定function
'   isErr の値で直接入力の可否を分岐する
    
    Dim i1 As Long
    Dim str, _
        inputMsg, _
        errMsg As String
    
    Select Case isErr
        Case False
            inputMsg = "プルダウンに選択したい項目がない場合は、直接入力してください"
        Case True
            inputMsg = "プルダウンから選択してください"
            errMsg = "入力できる値はプルダウンの値のみです"
    End Select
    
    For i1 = 0 To UBound(validation)    '配列validationを「,」区切りの文字列へ変換
        str = str + validation(i1)
        If i1 < UBound(validation) Then str = str + ","
    Next i1
    
    If str = "" Then str = "取引内容が設定されていません、直接入力をしてください"  'リストの文字列が空だった場合、代替文字を代入
    
    With Target.validation
        .Delete     'validationを設定する場合ははじめに必ずDelete
        .Add Type:=xlValidateList, _
            AlertStyle:=xlValidAlertStop, _
            Operator:=xlEqual, _
            Formula1:=str
        .InputMessage = inputMsg
        .ErrorMessage = errMsg
        .ShowInput = True
        .ShowError = isErr
        .IMEMode = xlIMEModeHiragana
    End With

End Sub

Public Function setCnvTable()
'   外部参照データにある計上科目変換表をThisWorkbookへ取り込むコード
'   最新更新日時をトリガーとして、Workbook内に控えてある前回の最新更新日時からアップデートがされていたら再取り込みを行う。
'   毎回の外部参照をすると動作遅延が生じるための動作高速化処理

    Dim wsCnvTable As Worksheet
    Dim path As String
    Dim wb As Workbook
    Dim fName As String
    Dim Ary
    Dim rcLastUpDate As Date
    Dim getLastUpDate As Date
    
    Set wsCnvTable = Worksheets("計上科目変換表")
    rcLastUpDate = wsCnvTable.Cells(1, 12)  '控えてある最新更新日時をセット
    
    getLastUpDate = getDateLastModified(rcLastUpDate) '現在の外部参照データファイルの最新更新日時を取得
    
    If getLastUpDate > rcLastUpDate Then    '取得した現在の更新日時
        path = ThisWorkbook.path & "\"
        fName = "外部参照データ.xlsx"
                
'      同ファイルが開いていた場合はデータだけを取得し開いたままに、閉じていた場合はデータ取得後閉じる処理分岐
        If isBookOpen(fName) Then
        
'            開いていた場合
            Ary = Workbooks(fName).Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion
        Else
        
'          閉じていた場合の処理
            Application.DisplayAlerts = False
            Workbooks.Open fileName:=path & fName, Password:=629545
            Ary = ActiveWorkbook.Worksheets("計上科目変換表").Cells(1, 1).CurrentRegion
            ActiveWorkbook.Close
            Application.DisplayAlerts = True
        End If
        
        With wsCnvTable
            .Cells(1, 1).CurrentRegion.ClearContents
            .Range(.Cells(1, 1), .Cells(UBound(Ary, 1), UBound(Ary, 2))) = Ary
            .Cells(1, 12) = getLastUpDate
        End With
        
        setCnvTable = Ary
    Else
'      更新がされていなかった場合は、同ブック内のシートより参照
        setCnvTable = wsCnvTable.Cells(1, 1).CurrentRegion
    End If
    
    Set wsCnvTable = Nothing    '解放
End Function

Private Function isBookOpen(bookName As String) As Boolean
    Dim bk As Workbook
    
    isBookOpen = False    '初期設定
    
'  開いているワークブックを回して該当ファイルが開いているか確認
    For Each bk In Workbooks
        If bk.Name = bookName Then
            isBookOpen = True
            Exit For
        End If
    Next
  
End Function
Private Function getDateLastModified(rcLastUpDate As Date)
'   外部参照データファイルの最新更新日時を取得するコード

    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FIleSystemObject")
    
    Dim fName As String
    Dim path As String
    Dim d As Date
    path = ThisWorkbook.path & "\"
    fName = "外部参照データ.xlsx"
    On Error Resume Next
    d = FSO.GetFile(path & fName).DateLastModified
    If Err.Number <> 0 Then
        Err.Clear
        d = rcLastUpDate
        MsgBox fName & "が見つかりませんでした", vbInformation, "Not find file"
    End If
    getDateLastModified = d
    Set FSO = Nothing
End Function

```

エクセルBookの一部の内容に問題が見つかりました。

エクセル VBA の処理で、
自分自身のブックを保存して閉じ、
すぐに先ほど閉じたブックを再起動する処理を実現させたいです。

ネットで調べても、
自身を閉じるまでの処理や、
他ブックを起動させる処理は書かれていましたが、
自分自身を再起動させる方法については見当たりませんでした。

ご教授をお願いしたいと思います。

VBAで自分自身のブックを再起動させたいです

プログラミングは、全く分からないのですが、Wordマクロのコードを教えてください。

Wordで編集作業をしています。毎回写真や画像を貼り付け、サイズ変更します。
写真は、25%に縮小し、画像は、縦31mm×横54mmにします。
写真と画像の縮小サイズがそれぞれ異なるため、マクロ記録のように、一括でサイズ変更ができません。1つ1つの写真または画像を選択した上で、それぞれのマクロ機能を設定しサイズ変更をできたらと思うのですが、どのようなコードでできますでしょうか？画像の縦31mm×横54mmへの変更の方が手間なので、こちらだけでも教えていただけたらと思います。どうぞよろしくお願いいたします。（Windows10を使っています。）

Wordマクロ　画像サイズの変更

エクセルのVBAに関して質問させて頂きます。
使用しているエクセルは2003です。

現在下記の動作をさせるものを作成したいのですが、
効率のいい方法が思いつきません。

エクセルシートの"A1"から”A800"までのセルに
「"Z1~Z100","Y1~Y100","WX1~WX200","UV1~UV200" ,"ST1~ST200"」
の文字列がそれぞれにバラバラ格納されています。
このとき"A1~A800”の中で重複している内容はありあせん。
また、上の文字列はそれぞれ100~200種類用意されていますが、
"A1~A800"が毎回全て埋まるわけではなく、なおかつ全ての種類を使用しているとは限りません。
全部のデータが今回は100個しかなく、"Z"は"Z7~Z11,Z23,Z25"がランダムに、残りは全て"UV"と"WX"で埋め尽くされているということもあるということです。

また"B"の行にはそれぞれデータ"A"の行に対応した値が格納されています。
Bの行には重複があります。

このとき、これらのデータを"A"行をキーとしてソートをかけると
Z1
Z10
Z11
・
・
Z2
Z21
となってしまいます。

これを
Z1
Z2
Z3
と最初の文字を無視した形でソートしたいのです。

なおかつ、
ソートの順番は "Z" "WX" "ST" "UV" "Y"
で行いたいのですがなにか方法はあるでしょうか？
文章だけでは説明が分かりにくいと思うので画像添付いたします。![イメージ説明](03091f5772e587c9b9fdf40c6fdb9c7c.png)

追記
ta-kun様
![イメージ説明](c7ec840a915789e234786bfe27bb4401.png)


追記
どれも大変すばらしくとても助かりました。
ありがとうございました。
ベストアンサーに関しましては私の個人的な好みと実際にそちらをベースとさせて
頂いたので選ばせて頂きました。
しかし、これとはいわず、それぞれのやりやすさ好みもあると思いますので
同じ壁にぶつかった方は皆様の回答をそれぞれ参考にして頂きたく思います。