Excel Worksheet to picture using VBA (Jpeg, Png etc)

This sample will show how to automate export of Excel sheet to image file.

You need to download and install ImageMagick library (Q16 version)

When ImageMagick is installed you could use this code to save your Excel worksheet to picture (use "view plain" option to copy code to clipboard):

Dim imObject As Object
'Create ImageMagick Object
Set imObject = CreateObject("ImageMagickObject.MagickImage.1")
'Copy selected area to clipboard as picture
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
'Save clipboard to image named c:\image.jpg
imObject.Convert "clipboard:myimage", "", "-quality", "85", "c:\image.jpg"

Export last table from Word to Excel

This sample will copy last table from each of given word documents to active sheet.

Sub CopyTables()
Set appWord = CreateObject("Word.Application")
On Error GoTo emergencyexit
fileNames = Array("c:\1.doc","c:\2.doc")
For Each Filename In fileNames
    Set docWord = Nothing
    Set docWord = appWord.Documents.Open(Filename)
    If Not docWord Is Nothing Then
        docWord.tables(docWord.tables.Count).Select
        appWord.Selection.Copy
        ActiveSheet.Paste
        docWord.Close
        ActiveSheet.UsedRange.Offset(ActiveSheet.UsedRange.Rows.Count).Resize(1, 1).Select
    End If
Next
emergencyexit:
appWord.Quit

End Sub

Excel Autofill VBA emulation

This code emulates double click on bottom right  corner of selected cell.

Sub Autofill()
    On Error Resume Next
    Dim checkRange As Range
    
    If RangeState(Selection) = 2 Then: Exit Sub
    
    selMaxRow = Selection.Row + Selection.Rows.Count - 1
    selColsCount = Selection.Columns.Count
    selRowsCount = Selection.Rows.Count
    usedRows = ActiveSheet.UsedRange.Rows.Count
    maxrow = selMaxRow
    row_offset = 0
        
    checkLeft = False
    checkRight = False
    checkCenter = False
    If Selection.Column > 1 Then
        If RangeState(Selection.Offset(0, -1).Resize(selRowsCount, 1)) = 1 Then
            checkLeft = True
        End If
    End If
    If Not checkLeft Then
        If (Selection.Column + selColsCount) < ActiveSheet.Cells.Columns.Count Then
            If RangeState(Selection.Offset(0, selColsCount).Resize(selRowsCount, 1)) = 1 Then: checkRight = True
        End If
    End If

    Set checkRange = Selection.Offset(selRowsCount).Resize(1, selColsCount)
    
    If Not checkLeft And Not checkRight Then
        If RangeState(checkRange) = 1 Then: checkCenter = True
    Else
        checkCenter = True
    End If
    
    For row_offset = 0 To usedRows - Selection.Row - selRowsCount
        If (selMaxRow + row_offset) < usedRows And checkCenter Then
            tmp = RangeState(checkRange.Offset(row_offset))
            If row_offset = 0 Then: center_state = tmp
            If tmp <> center_state Then: checkCenter = False
            If center_state = 3 Then: checkCenter = False
        End If
        
        If checkLeft And center_state = 2 Then
            left_state = RangeState(checkRange.Offset(row_offset, -1).Resize(1, 1))
            If left_state = 2 Or left_state = 3 Then: Exit For
        ElseIf checkRight And center_state = 2 Then
            right_state = RangeState(checkRange.Offset(row_offset, selColsCount).Resize(1, 1))
            If right_state = 2 Or right_state = 3 Then: Exit For
        End If
                
        If checkCenter Then: maxrow = maxrow + 1
    Next
    
    If maxrow > selMaxRow Then
        Selection.Autofill Destination:=Selection.Resize(maxrow - (Selection.Row) + 1)
        Selection.Resize(maxrow - Selection.Row + 1).Select
    End If
End Sub


Function RangeState(rng As Range)
    RangeState = 0
    If IsArray(rng.Formula) Then
        For Each Formula In rng.Formula
            If Formula <> "" Then
                RangeState = RangeState Or 1
            Else
                RangeState = RangeState Or 2
            End If
        Next
    Else
        If rng.Formula <> "" Then
            RangeState = 1
        Else
            RangeState = 2
        End If
    End If
End Function