View Single Post
 
Old 08-27-2018, 04:24 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

You still haven't given enough information so I'm just going to guess what it is you want to do.

Continuing the theme, I would set up each of the Text Content Controls with a Tag that includes both the sheet and cell address in the form "Sheetname!A2". Then I would alter the previous code to...
Code:
Sub Open_CheckedCCs_Click()
Dim aCC As ContentControl, xlApp As Object, xlWkBk As Object
  Dim sPath As String, sFullPath As String
    sPath = "C:\Temp\MyDocs\"    'xl files in fixed location
  On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
  On Error GoTo 0
  For Each aCC In ActiveDocument.Range.ContentControls
    If aCC.Type = wdContentControlCheckBox Then
      sFullPath = sPath & aCC.Tag
      If aCC.Checked And fFileExists(sFullPath) Then
        If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application")
        Set xlWkBk = xlApp.Workbooks.Open(sFullPath)
        xlApp.Visible = True
        xlWkBk.Activate
        UpdateXL xlWkBk
        'xlWkBk.Save
        'xlWkBk.Close
      End If
    End If
  Next aCC
End Sub

Function fFileExists(sPath As String) As Boolean
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  fFileExists = fso.FileExists(sPath)
End Function

Function UpdateXL(xlWkBk As Object)
  Dim aCC As ContentControl, sSheet As String, sCell As String, sValue As String
  For Each aCC In ActiveDocument.Range.ContentControls
    If aCC.Type = wdContentControlText Then
      sSheet = Split(aCC.Tag, "!")(0)
      sCell = Split(aCC.Tag, "!")(1)
      sValue = aCC.Range.Text
      xlWkBk.Sheets(sSheet).Range(sCell).Value = sValue
    End If
  Next aCC
End Function
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote