Доступ к VBA — экспорт в Excel со встроенными файлами

#excel #vba #ms-access #ole

#excel #vba #ms-access #ole

Вопрос:

Я опубликовал это на UA, но подумал, что попробую и здесь. В Access 2013 у меня есть процесс экспорта и форматирования данных в электронную таблицу Excel, включая встраивание изображений и документов. При циклическом просмотре вложений для электронной таблицы, если вложение представляет собой изображение, значок представляет собой всего лишь уменьшенную версию самого изображения. Но если вложение представляет собой документ (Word, Excel и т.д.), Тогда используемый значок является значком приложения.

На прилагаемом скриншоте вы можете видеть, что экспорт отлично работает для изображений. Однако для файлов Excel это добавляет пробел под значком, который нельзя удалить, а размер и пропорции значка неправильные. Для документов Word размер правильный, но значок ничего не отображается; тем не менее, вы можете дважды щелкнуть «кажущуюся пустой» ячейку и открыть вложение. Используемые значки взяты из файла значков установщика Windows.

Скриншот экспорта в Excel

Ниже приведен код для извлечения. Он перебирает таблицу, содержащую путь и тип вложения, которое будет экспортировано, и путь к значку, который будет использоваться (файлы вложений напрямую не хранятся в БД; на них есть ссылки).

Есть идеи о том, как заставить значки отображаться правильно?

 Private Sub cmdExport_Click()
On Error GoTo ErrProc
  
  Dim xlApp As Excel.Application    'Create an instance of Excel application
  Dim xlBook As Excel.Workbook      'Create a new Excel workbook
  Dim xlAtch As Excel.Worksheet      'Create a tab with Attachment details
  Dim strSQL As String              'SQL for the Attachment recordset
  Dim rsAtch As DAO.Recordset        'Attachment recordset
  Dim x As Integer                  'Counter for Attachment line numbers
  Dim Img As Excel.Shape            'Process the Image Attachments
  Dim Atch As OLEObject             'Process the non-Image Attachments
    
  'Create an instance of Excel.  Keep it hidden until it is finished
  Set xlApp = Excel.Application
  xlApp.Visible = False
  Set xlBook = xlApp.Workbooks.Add
  xlBook.Worksheets.Add
  
  'Build the Image Reference SQL
  strSQL = "SELECT * FROM tblAttachments"
  Set rsAtch = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  
  'Add a new worksheet
  Set xlAtch = xlBook.Worksheets(1)
  
  With xlAtch
    'Build Column Headings
    .Range("A1").Value = "Name"
    .Range("B1").Value = "Attachment"
    .Range("C1").Value = "Attachment Path"
      
    .Range("A2:A5").RowHeight = 65
    .Columns("B").ColumnWidth = 17
    
    'Populate the detail data
    x = 2   'Set initial row counter
    Do While Not rsAtch.EOF
      .Range("A" amp; x).Value = Nz(rsAtch!AttachmentName, "")
      .Range("C" amp; x).Value = Nz(rsAtch!attachmentpath, "")

      If rsAtch!AttachmentType = "Image" Then
                  
        'Add the image; the initial size is set at 2000 and then resized below.
        Set Img = .Shapes.AddPicture(FileName:=rsAtch!attachmentpath, _
                  linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                  Left:=.Range("B" amp; x).Left, Width:=2000, _
                  Top:=.Range("B" amp; x).Top, Height:=2000)
        
        'Resize the image
        Img.Width = .Range("B" amp; x).Width           'Width = cell width
        Img.Height = .Range("B" amp; x).Height         'Height = cell height
        Img.Placement = 1                           'Move and size with the cell
    
      Else 'non-image attachment
        Set Atch = .OLEObjects.Add(FileName:=rsAtch!attachmentpath, _
          iconindex:=0, _
          Link:=False, DisplayAsIcon:=True, IconFileName:=rsAtch!iconpath, _
          Left:=ActiveSheet.Range("B" amp; x).Left, Width:=.Range("B" amp; x).Width, _
          Top:=ActiveSheet.Range("B" amp; x).Top, Height:=.Range("B" amp; x).Height)
          
        Atch.Placement = 1                           'Move and size with the cell
      End If
      
      x = x   1
      rsAtch.MoveNext
    Loop
    
    'Format the detail section as an Excel table
    .ListObjects.Add(xlSrcRange, Range("$A$1:$C$" amp; x - 1), , xlYes).Name = "Attachments"
    .Range("Attachments[#All]").Select
    .ListObjects("Attachments").TableStyle = "TableStyleLight8"
    
    .Range("A2").Select     'Put the focus on the first data cell
    .Columns("A:C").AutoFit 'Autofit the column widths
    
  End With

ExitProc:
  On Error Resume Next
  xlApp.Visible = True    'Set Excel to visible
  'Cleanup
  rsAtch.Close
  Set rsAtch = Nothing
  Set Img = Nothing
  Set Atch = Nothing
  
  Exit Sub
  
ErrProc:
  MsgBox Err.Number amp; "; " amp; Err.Description, vbOKOnly, "Error"
  Resume ExitProc

End Sub
  

Ответ №1:

Я подошел ближе и, возможно, настолько далеко, насколько смогу с этим. Файлы значков, которые я использовал (формат PNG), были скопированы и сохранены в каталоге значков для доступа к использованию. Это отлично работало при отображении значков в Access, но плохо работало при экспорте.

Перепробовав десятки комбинаций параметров и логического потока, я нашел то, что «в основном» работает. Для параметров мне пришлось добавить ярлык значка (я просто использую имя файла) и использовать файлы значков установщика Windows. Все еще есть некоторые проблемы с размером, которые я решил с помощью этого запутанного процесса: сначала измените размер ячейки, в которой я хочу разместить вложение, затем добавьте вложение, затем измените размер вложения, затем снова измените размер ячейки. Вывод возможен для любых изображений или вложений документов MS Office.

Проблемы, связанные с таким подходом, заключаются в следующем:

  1. Поскольку файлы PNG не будут работать, и я ограничен использованием значков установщика Windows, я не могу получить никаких значков для программ, отличных от Windows, таких как PDF-файл.
  2. Значки установщика Windows находятся в «C:WindowsInstaller {90150000-0011-0000-1000-0000000FF1CE}» на моем компьютере, и я уверен, что этот каталог будет зависеть от пользователя. До сих пор я не смог найти какой-либо тип переменной среды или другую ссылку для поиска файлов значков, не зная точно, где искать.
  3. Значки больше не отображаются в Access в формах при ссылке на файлы. Я предполагаю, что это связано с тем, что значки на самом деле являются исполняемыми файлами, а не файлами изображений.