Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=1, Name:=""
ActiveDocument.PrintOut Range:=wdPrintCurrentPage

Function RndChr(length As Integer) As String
Dim s As Byte, x As Long
Randomize
For x = 1 To length
s = 48 + Int(Rnd() * 43) 'по 43Chr вкл
If s > 57 And s < 65 Then s = s - 7
RndChr = RndChr & Chr(s)
If Not CBool(x Mod 5) And x <> length Then RndChr = RndChr & "-"
Next
End Function

' Scan for Word 2013
' Author: Gu "nter Born www.borncity.de blog.borncity.com"
' Implements a Scan function in Word 2013
' ----------------------
' For 64-bit app need declare with PtrSafe key:
' Private Declare PtrSafe Function GetTempPath Lib "kernel32"....

 Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Function TempPath() As String
Const MaxPathLen = 256 ' Max path length
Dim FolderName As String ' Folder name
Dim ReturnVar As Long ' Return Value
FolderName = String(MaxPathLen, 0)
ReturnVar = GetTempPath(MaxPathLen, FolderName)
If ReturnVar <> 0 Then
TempPath = Left(FolderName, InStr(FolderName, Chr(0)) - 1)
Else
TempPath = vbNullString
End If
End Function

Sub Scan()
'
' Scan Macro, to be invoked in Word
'
On Error Resume Next
Dim objCommonDialog As WIA.CommonDialog
Dim objImage As WIA.ImageFile
Dim strDateiname
' instantiate Scan WIA objects
Set objCommonDialog = New WIA.CommonDialog
Set objImage = objCommonDialog.ShowAcquireImage
strDateiname = TempPath & "Scan.jpg" ' set temporary file
If Not objImage Is Nothing Then
Kill strDateiname
objImage.SaveFile strDateiname ' save into temp file
Selection.InlineShapes.AddPicture strDateiname ' insert in doc
Set objImage = Nothing
End If
Set objCommonDialog = Nothing
' MsgBox strDateiname  ' test output
End Sub