| Author |
 Topic  |
|
|
Surrogate
Russia
122 Posts |
 Posted - 11/09/2011 : 06:40:19
|
борюсь с Visio2010…
зачем-то там по умолчанию стоит в размерах листа галочка "Растянуть по необходимости", и нет опции "Такой же как размер листа принтера".
А именно такой размер листа рисунка нужен в 99% случаев.
сваял макрос который снимает Autosize и приводит в соответствие размер листа рисунка и размер листа бумаги в принтере.
Sub auto()
Dim pg As Page
For Each pg In ActiveDocument.Pages
pg.AutoSize = False
'Application.ActivePage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawSizeType).FormulaU = 0
cr = pg.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPaperKind)
' cr - аналог PaperKind shapesheet
co = pg.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation)
' co - ориентация листа аналог PaperKind shapesheet
ds = Replace(pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawingScale).FormulaU, " mm", "")
' ds - размер рисунка, аналог DrawingScale shapesheet
ps = Replace(pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageScale).FormulaU, " mm", "")
' ps - размер листа принтера, аналог PageScale shapesheet
sc = ds / ps ' собственно масштаб
Select Case cr
Case 11
w = 148
h = 210
Case 9
w = 210
h = 297
Case 8
w = 297
h = 420
Case 66
w = 420
h = 594
Case 129
w = 594
h = 841
Case 127
w = 841
h = 1189
End Select
Select Case co
Case 1
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = w * sc & " mm"
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = h * sc & " mm"
Case 2
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = h * sc & " mm"
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = w * sc & " mm"
End Select
Next pg
End Sub
проблема возникает на листах с масштабом. например при масштабе 1:50
DrawingScale = 1 m (или ds в макросе)
PageScale = 2 mm (или ps в макросе)
таким образом получаем ошибку при попытке поделить sc = ds/ps
VBA вообще разбирается в единицах измерения ?
† |
|
|
Surrogate
Russia
122 Posts |
Posted - 11/09/2011 : 07:29:36
|
нашел обходной путь:
добавляю на каждую страницу раздел Scratch, в столбце A получаю отношение DrawingScale/PageScale. полученное значение и есть собственно масштаб :)
Sub auto()
Dim pg As Page
For Each pg In ActiveDocument.Pages
pg.PageSheet.OpenSheetWindow
Application.ActiveWindow.Shape.AddSection visSectionScratch
Application.ActiveWindow.Shape.AddRow visSectionScratch, visRowLast, visTagDefault
Application.ActiveWindow.Shape.CellsSRC(visSectionScratch, 0, visScratchA).FormulaU = "DrawingScale/PageScale"
Set sc = Application.ActiveWindow.Shape.CellsSRC(visSectionScratch, 0, visScratchA) ' собственно масштаб
pg.AutoSize = False
cr = pg.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPaperKind)
' cr - аналог PaperKind shapesheet
co = pg.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation)
' co - ориентация листа аналог PaperKind shapesheet
ds = Replace(pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawingScale).FormulaU, " mm", "")
' ds - размер рисунка, аналог DrawingScale shapesheet
ps = Replace(pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageScale).FormulaU, " mm", "")
' ps - размер листа принтера, анало
Select Case cr
Case 11
w = 148
h = 210
Case 9
w = 210
h = 297
Case 8
w = 297
h = 420
Case 66
w = 420
h = 594
Case 129
w = 594
h = 841
Case 127
w = 841
h = 1189
End Select
Debug.Print w, h
Select Case co
Case 1
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = w * sc & " mm"
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = h * sc & " mm"
Case 2
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = h * sc & " mm"
pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = w * sc & " mm"
End Select
Application.ActiveWindow.Shape.DeleteSection visSectionScratch
Application.ActiveWindow.Close
Next pg
End Sub
в конце раздел Scratch удаляю, вдруг еще раз придется макрос запускать в этом файле…
вопрос остается: есть более простые способы конвертации единиц измерения ?
† |
Edited by - Surrogate on 11/09/2011 09:19:55 |
 |
|
|
Tumanov
Russia
1198 Posts |
Posted - 11/09/2011 : 18:03:57
|
Скорее всего использование шейп-листа всего лишь помогает Вам (неявно) привести величины к единиым единицам измерения.
Но вполне возможно, той же цели можно достичь, если считывать не формулы, а значения. При этом и то, и другое будет в дюймах.
ds = pg.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawingScale)
Вот так не пробовали?
|
|
|
|
Surrogate
Russia
122 Posts |
Posted - 11/10/2011 : 07:07:05
|
Спасибо, Геннадий! именно с такого варианта я и начинал…
но меня раздражали размеры в дюймах, поэтому я тут так намудрил :)
все равно размеры листов принтера в шейп-шите страницы хранятся в виде констант PaperKind. для масштабирования мне были нужны не размеры, а их отношение !!! 
† |
|
|
| |
Topic |
|
|
|
All Forums
Масштабирование через VBA