vba経由でExcelファイルをリモートで非アクティブにする

Question

vba経由でExcelファイルをリモートで非アクティブ化する方法があるかどうかを知りたいと思います。

問題：
私の会社は、顧客に見積書を提供するために、販売のためのExcelファイルを使用しています。私たちの価格設定スキームが更新されると、Excelファイルの新しいバージョンがセールスチームに送信されます。次に起こる明白なことは、ファイルの最新バージョンを使用して見積もりを提供しないこと>顧客が間違った価格を取得することです。

私がこれまでに試したこと：
ファイルを定義された日付に期限切れにするための時間爆弾を実装しました。これの問題は、Excelファイルの更新が不規則に発生することです。

私が覚えていること
Excelファイルが開始されると、VBAスクリプトはWebサーバーに最新のバージョン番号を問い合わせます。現在開いているExcelファイルのバージョン番号がサーバーが提供するバージョン番号より低い場合、ファイルはロックアップされます。

これはExcelとVBAで実現できるものですか？私はこれがトロイの木馬やウイルスのように見えるかもしれないので、これがWindowsセキュリティなどにいくつかの問題を引き起こすと想像することができます。

大変お手伝いします！

Answer 1

あなたは彼らに（「Microsoft ExcelのVBAとマクロ」からトムUrtisの礼儀）以下のコードを.xlsmファイルを送信する場合は選択した日付が経過すると、ファイルを削除します。 このコードに注意し、必ずバックアップコピーを保存してください。

このサブをvbaの「ブック」セクションに貼り付けます。このサブファイルは、ファイルが開かれるたびに実行されます。現在の日付が選択された日付の後にある場合、ファイルを削除します。

Private Sub workbook_open() 

    If Date > CDate("13.07.16") Then 

     With ThisWorkbook 

      .Saved = True 
      .ChangeFileAccess xlReadOnly 
      Kill .FullName 
      .Close False 
     End With 

    End If 

End Sub 

Answer 2

また、バージョンが利用できるようになりますしたセルを参照して、ファイルのバージョンによって、日付による検査はできませんが。

Private Sub workbook_open() 

    If [A1].value > "v.02.15" Then 

     With ThisWorkbook 

      .Saved = True 
      .ChangeFileAccess xlReadOnly 
      Kill .FullName 
      .Close False 
     End With 

    End If 

End Sub 

Answer 3

Sub ПримерИспользования() 
    Dim ra As Range: On Error Resume Next 

    Set ra = GetQueryRange("http://ExcelVBA.ru/", 6) 
    Debug.Print ra '.Address ' переменная ra содержит ссылку на диапазон ячеек $A$1:$C$15, 
    ' содержащий данные 6-й таблицы главной страницы сайта ExcelVBA.ru 

End Sub 

Function GetQueryRange(ByVal SearchLink$, Optional ByVal Tables$) As Range 
    On Error Resume Next: Err.Clear 
    Dim tmpSheet As Worksheet: Set tmpSheet = ThisWorkbook.Worksheets("tmpWQ") 
    If tmpSheet Is Nothing Then 
     Application.ScreenUpdating = False 
     Set tmpSheet = ThisWorkbook.Worksheets.Add 
     tmpSheet.Name = "tmpWQ" 
     tmpSheet.Visible = xlSheetVeryHidden 
    End If 
    If tmpSheet Is Nothing Then 
     msg$ = "Не удалось добавить скрытый лист «tmpWQ» в файл программы" 
     MsgBox msg, vbCritical, "Невозможно выполнить запрос к сайту": End 
    End If 

    tmpSheet.Cells.Delete: DoEvents: Err.Clear 
    With tmpSheet.QueryTables.Add("URL;" & SearchLink$, tmpSheet.Range("A1")) 
     If Len(Tables$) Then 
      .WebSelectionType = xlSpecifiedTables 
      .WebTables = Tables$ 
     Else 
      .WebSelectionType = xlEntirePage 
     End If 
     .FillAdjacentFormulas = False: .PreserveFormatting = True 
     .RefreshOnFileOpen = False: DoEvents 
     .WebFormatting = xlWebFormattingAll 
     .Refresh BackgroundQuery:=False: DoEvents 
     If Err = 0 Then Set GetQueryRange = tmpSheet.UsedRange 
     .Delete: DoEvents 
    End With 
End Function 

変更線3 ターンウィンドウで参照Locals WindowView \ Locals Windowのパス。 マクロを起動する前にDebug.Print ra '.Address' ra variable contains a reference to a cell range $ A $ 1: $ C $ 15, マクロを実行し、Locals Windowを選択してra \ Value2を選択します。これはサイトのデータになります。

今すぐサイトからのデータを変数raに保存され、それらは、ラインを変更するには、次のようにすることができ取るされます。

Debug.Print ra.Value2(2, 2) 'result: "У вас есть интернет-магазин?" 

このコードはサイトからコピーされます。http://excelvba.ru/code/WebQueryRange