Привет, я создаю код VB для создания таблицы в слове, но я получил ошибку "Требуется объект" на objTb1 Я уже даю Dim objTb1 as object, так как решить эту помощь PLZ вот мой код
Sub Create_Table_In_Word()
Dim objWord As Object
Dim objDoc As Object
Dim objTbl As Object
Dim objRow As Object
Dim objCol As Object
Dim lngCols As Long
Dim lngRows As Long
Dim I As Long
lngCols = 2
lngRows = 4
Range("M7").FormulaR1C1 = "=IF(MID(RC[-12],SEARCH("":-"",RC[-12],1)+3,LEN(RC[-12]))=""Additional Classroom M.L."",""ACR M.L."",IF(MID(RC[-12],SEARCH("":-"",RC[-12],1)+3,LEN(RC[-12]))=""Pathya Pustak Mandal"",""PPM"",IF(MID(RC[-12],SEARCH("":-"",RC[-12],1)+3,LEN(RC[-12]))=""Toilet Block ( Boys)"",""Boy’s T.B."",IF(MID(RC[-12],SEARCH("":-"",RC[-12],1)+3,LEN(RC[-12]))=""Toilet Block ( Girls)"",""Girl’s T.B."",""""))))"
ActiveSheet.Range("A8", Range("L65536").End(xlUp)).AutoFilter Field:=9, Criteria1:="<>"
Range("I8").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add(DocumentType:=0)
With objDoc.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With objDoc.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(1.25)
.BottomMargin = CentimetersToPoints(2.54)
.LeftMargin = CentimetersToPoints(2.54)
.RightMargin = CentimetersToPoints(2.54)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
.SectionDirection = wdSectionDirectionLtr
End With
Set objTbl = objDoc.Tables.Add(Range:=objDoc.Paragraphs(1).Range, NumRows:=lngRows, NumColumns:=lngCols)
With objTb1
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = False
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = False
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
With objTb1.Rows
.WrapAroundText = True
.HorizontalPosition = wdTableCenter
.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
.DistanceLeft = CentimetersToPoints(0.32)
.DistanceRight = CentimetersToPoints(0.32)
.VerticalPosition = CentimetersToPoints(1)
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.DistanceTop = CentimetersToPoints(0)
.DistanceBottom = CentimetersToPoints(0)
.AllowOverlap = True
End With
objTb1.Style = "Grid Table 3 - Accent 6"
objTb1.ApplyStyleHeadingRows = Not objTb1.ApplyStyleHeadingRows
objTb1.ApplyStyleFirstColumn = Not objTb1.ApplyStyleFirstColumn
'Selection.Tables(1)
objTb1.Select
objTb1.Columns.PreferredWidthType = wdPreferredWidthPoints
objTb1.Columns.PreferredWidth = CentimetersToPoints(9)
objTb1.Rows.Item(1).Height = CentimetersToPoints(1.2)
objTb1.Rows.Item(2).Height = CentimetersToPoints(10.2)
objTb1.Rows.Item(3).Height = CentimetersToPoints(1.2)
objTb1.Rows.Item(4).Height = CentimetersToPoints(10.2)
For I = 1 To 3
If I = 2 Then GoTo nextcell
sname = ActiveCell.Offset(0, -6).Value
tname = ActiveCell.Offset(0, -7).Value
dt = ActiveCell.Value
LOW = ActiveCell.Offset(0, 1).Value
act = Range("M7").Value
'Set objRow = objTbl.Rows(I)
Set objRow = objTbl.Rows(I)
Set objCol = objRow.Cells(1)
objCol.Range.Text = "Name of School: " & sname & vbNewLine & "Taluka: " & tname
Set objRow = objTbl.Rows(I)
Set objCol = objRow.Cells(2)
objCol.Range.Text = "Date: " & dt & vbNewLine & "Level of Work: " & LOW & vbNewLine & "Activity: " & act
nextcell:
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Next I
Set objCol = Nothing
Set objRow = Nothing
Set objDoc = Nothing
Set objWord = Nothing
End Sub
Редактировать 1
Извините, моя ошибка, есть две переменные, одна из которых objTb1, а другая - objTbl, поэтому я заменил их на objtb, поэтому никакой путаницы
Редактировать 2
Я добавляю изображение в таблицу, поэтому я добавил код
For x = 1 To 2
If x = 1 Then
imgx = img1
Else
imgx = img2
End If
objtb.Cell(I + 1, x).Range.InlineShapes.AddPicture imgx
With Selection
.ShapeRange.RelativeHorizontalPosition =
wdRelativeHorizontalPositionColumn
.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizeMargin
.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizeMargin
.ShapeRange.Left = CentimetersToPoints(0.23)
.ShapeRange.LeftRelative = wdShapePositionRelativeNone
.ShapeRange.Top = CentimetersToPoints(0.05)
.ShapeRange.TopRelative = wdShapePositionRelativeNone
.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
.ShapeRange.LockAnchor = False
.ShapeRange.LayoutInCell = True
.ShapeRange.WrapFormat.AllowOverlap = True
.ShapeRange.WrapFormat.Side = wdWrapBoth
.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
.ShapeRange.WrapFormat.Type = 3
.ShapeRange.ZOrder 4
End With
Next x
после помещения данных в строку, и он показывает, что объект ошибки не 't поддерживает свойство или метод в строке with selection
.ShapeRange.RelativeHorizontalPosition =
wdRelativeHorizontalPositionColumn, поэтому plz help