в ворде видно текс-боксы только на 1 листе, а дальше нет?

Программирование на Visual Basic for Applications
uzer_@
Обычный пользователь
Обычный пользователь
 
Сообщения: 57
Зарегистрирован: 16.08.2005 (Вт) 16:44
Откуда: Санкт-Петербург

в ворде видно текс-боксы только на 1 листе, а дальше нет?

Сообщение uzer_@ » 01.12.2005 (Чт) 14:29

Sub ôîòêè()
Dim fs As New FileSystemObject
Dim fl As Folder
Dim fls As Files
Dim f As File
Dim v() As String
Dim i As Integer
Dim j As Integer, sleva As Integer, sverhy As Integer
Dim path As String
path = "C:\Documents and Settings\Àäìèíèñòðàòîð\Ìîè äîêóìåíòû\ñèìåíñ\ïå÷àòü\"
Set fl = fs.GetFolder(path)
Set fls = fl.Files
ReDim v(1 To fls.Count)
For Each f In fls
i = i + 1
v(i) = f.Name
Next
sverhy = 1
For j = 1 To 2
For i = 1 To fls.Count
If j = 2 Then sleva = 14 Else sleva = 1
ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(sleva), _
CentimetersToPoints(sverhy), CentimetersToPoints(12), CentimetersToPoints(9)).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.InlineShapes.AddPicture FileName:=path + v(i), LinkToFile:=False, _
SaveWithDocument:=True
Selection.TypeParagraph
sverhy = sverhy + 10
Next
Next
End Sub

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 01.12.2005 (Чт) 17:09

Меняй привязку на новый лист и начинай позиционирование (по высоте) сначала.
Lasciate ogni speranza, voi ch'entrate.

uzer_@
Обычный пользователь
Обычный пользователь
 
Сообщения: 57
Зарегистрирован: 16.08.2005 (Вт) 16:44
Откуда: Санкт-Петербург

Сообщение uzer_@ » 02.12.2005 (Пт) 9:44

Я идиот! Убейте меня, кто-нибудь!Я идиот! Убейте меня, кто-нибудь!Я идиот! Убейте меня, кто-нибудь!???

uzer_@
Обычный пользователь
Обычный пользователь
 
Сообщения: 57
Зарегистрирован: 16.08.2005 (Вт) 16:44
Откуда: Санкт-Петербург

некрасиво конечно но работает

Сообщение uzer_@ » 05.12.2005 (Пн) 14:40

Sub фотки()
Dim fs As New FileSystemObject
Dim fl As Folder
Dim fls As Files
Dim f As File
Dim v() As String, bln As Boolean, bln1 As Boolean, bln2 As Boolean
Dim i As Integer
Dim j As Integer, sleva As Integer, sverhy As Integer
Dim path As String

path = "C:\Documents and Settings\Администратор\Мои документы\сименс\печать\"
Set fl = fs.GetFolder(path)
Set fls = fl.Files
ReDim v(1 To fls.Count)
For Each f In fls
i = i + 1
v(i) = f.Name
Next
sverhy = 1
sleva = 2
bln = True
bln1 = False
For i = 1 To fls.Count
If bln = False Then
sleva = 15
ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(sleva), _
CentimetersToPoints(sverhy), CentimetersToPoints(12), CentimetersToPoints(9)).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.InlineShapes.AddPicture FileName:=path + v(i), LinkToFile:=False, _
SaveWithDocument:=True
ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(sleva), _
CentimetersToPoints(sverhy + 8), MillimetersToPoints(42), MillimetersToPoints(7)).Select
Selection.ShapeRange.TextFrame.TextRange.Text = podpis(v(i))
bln = True
bln1 = True
GoTo metka
End If
If bln = True Then
sleva = 2
ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(sleva), _
CentimetersToPoints(sverhy), CentimetersToPoints(12), CentimetersToPoints(9)).Select
Selection.ShapeRange.TextFrame.TextRange.Select
Selection.Collapse
Selection.InlineShapes.AddPicture FileName:=path + v(i), LinkToFile:=False, _
SaveWithDocument:=True
ThisDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(sleva), _
CentimetersToPoints(sverhy + 8), MillimetersToPoints(42), MillimetersToPoints(7)).Select
Selection.ShapeRange.TextFrame.TextRange.Text = podpis(v(i))
bln = False
End If
metka:
If bln1 = True Then
sverhy = sverhy + 10
bln1 = False

If sverhy = 21 Then
'не знаю как убрать ссылку объекта selection с надписи, поэтому
'методом н. т. сделал так
ActiveWindow.View.Type = wdNormalView
ActiveWindow.View.Type = wdPrintView
'вставка нового листа
Selection.InsertBreak Type:=wdPageBreak
'перемещение курсора на новый лист, иначе несмотря на св-во top=1 все равно
'addtextbox на уже 2 лист, где уже есть фотки
Selection.MoveLeft Unit:=wdCharacter, Count:=1
sverhy = 1
End If
End If

Next
End Sub

uzer_@
Обычный пользователь
Обычный пользователь
 
Сообщения: 57
Зарегистрирован: 16.08.2005 (Вт) 16:44
Откуда: Санкт-Петербург

туда же

Сообщение uzer_@ » 05.12.2005 (Пн) 14:43

фразу меняй привязку на новый лист в меру испорченности понял так
'не знаю как убрать ссылку объекта selection с надписи, поэтому
'методом н. т. сделал так
ActiveWindow.View.Type = wdNormalView
ActiveWindow.View.Type = wdPrintView
'вставка нового листа
Selection.InsertBreak Type:=wdPageBreak
'перемещение курсора на новый лист, иначе несмотря на св-во top=1 все равно
'addtextbox на уже 2 лист, где уже есть фотки
Selection.MoveLeft Unit:=wdCharacter, Count:=1
sverhy = 1
если есть мнения по поводу убрать ссылку объекта selection с надписи, буду признателен

alibek
Большой Человек
Большой Человек
 
Сообщения: 14205
Зарегистрирован: 19.04.2002 (Пт) 11:40
Откуда: Russia

Сообщение alibek » 05.12.2005 (Пн) 14:48

Я не это имел ввиду.
Я имел ввиду ShapeRange.Anchor.
Lasciate ogni speranza, voi ch'entrate.


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: Google-бот и гости: 97

    TopList