ArthurP

Boa noite, Prezados, criei um arquivo de mala direta com mais de 1000 fotos, porém as fotos não atualizaram sua referência. Preciso clicar em cima de cada uma e apertar “F9” para atualizar a foto. Se seleciono o texto todo (ctrl+t) e aperto "F9" o word trava. Queria criar uma macro para atualizar todas as imagens de uma só vez. Quando gravo sei que a função para atualizar fica "Selection.Fields.Update" E achei uma macro que roda em todas as imagens diminuído o tamanho, porém não atualiza a referencia. Queria que em vez de diminuir o tamanho ela atualizasse a foto. Segue a macro de edição de tamanho. Sub Macro1() Dim insertedPicture As InlineShape Dim insertedShape As Shape Dim imgMult As Single imgMult = Fields.Update For Each insertedPicture In ActiveDocument.InlineShapes insertedPicture.Select insertedPicture.Width = insertedPicture.Width * imgMult / insertedPicture.Height insertedPicture.Height = imgMult Next End Sub Queria adaptar para atualizar a imagem “ Selection.Fields.Update “ Obrigado!

Pessoal tenho um arquivo de Excel onde na primeira coluna estão os nomes dos arquivos, e nas demais textos a serem colados nos devidos arquivos, gostaria de saber como colocar estes textos em lugares específicos dos arquivos de forma automática. Arquivo no Excel Todo o “texto 1” ficara respectivamente no arquivo de destino, em um lugar desterminado. Parece besteira porém são muitos arquivos, e não sei como fazer. Obrigado!

Não é uma única alteração, são diversas. Pois isso queria saber se tem uma meio genérica parecida com esta acima, para ir ajustando a necessidade. um exemplo é: é rodar esta macro gravada em todos os arquivos. Documents.Open FileName:="3024-01-71-G-10448.docx", ConfirmConversions:= _ False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" With ActiveDocument.Styles("título 1").ParagraphFormat .LeftIndent = CentimetersToPoints(0.25) .RightIndent = CentimetersToPoints(0.25) .SpaceBefore = 18 .SpaceBeforeAuto = False .SpaceAfter = 12 .SpaceAfterAuto = False .LineSpacingRule = wdLineSpaceSingle .Alignment = wdAlignParagraphLeft .WidowControl = True .KeepWithNext = True .KeepTogether = True .PageBreakBefore = False .NoLineNumber = False .Hyphenation = True .FirstLineIndent = CentimetersToPoints(0) .OutlineLevel = wdOutlineLevel1 .CharacterUnitLeftIndent = 0 .CharacterUnitRightIndent = 0 .CharacterUnitFirstLineIndent = 0 .LineUnitBefore = 0 .LineUnitAfter = 0 .MirrorIndents = False .TextboxTightWrap = wdTightNone .CollapsedByDefault = False End With ActiveDocument.Styles("título 1").NoSpaceBetweenParagraphsOfSameStyle = _ False With ActiveDocument.Styles("título 1").ParagraphFormat With .Shading .Texture = wdTextureNone .ForegroundPatternColor = wdColorAutomatic .BackgroundPatternColor = 5296274 End With With .Borders(wdBorderLeft) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt .Color = 5296274 End With With .Borders(wdBorderRight) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt .Color = 5296274 End With With .Borders(wdBorderTop) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt .Color = 5296274 End With With .Borders(wdBorderBottom) .LineStyle = wdLineStyleSingle .LineWidth = wdLineWidth050pt .Color = 5296274 End With With .Borders .DistanceFromTop = 4 .DistanceFromLeft = 6 .DistanceFromBottom = 4 .DistanceFromRight = 6 .Shadow = False End With End With With ActiveDocument.Styles("título 1") .AutomaticallyUpdate = False .BaseStyle = "Normal" .NextParagraphStyle = "Normal" End With Selection.MoveRight Unit:=wdWord, Count:=6, Extend:=wdExtend With Selection.Font .Name = "+Títulos" .Size = 25 .Bold = True .Italic = False .Underline = wdUnderlineNone .UnderlineColor = wdColorAutomatic .StrikeThrough = False .DoubleStrikeThrough = False .Outline = False .Emboss = False .Shadow = False .Hidden = False .SmallCaps = False .AllCaps = True .Color = 5296274 .Engrave = False .Superscript = False .Subscript = False .Spacing = 0 .Scaling = 100 .Position = 0 .Kerning = 14 .Animation = wdAnimationNone .Ligatures = wdLigaturesNone .NumberSpacing = wdNumberSpacingDefault .NumberForm = wdNumberFormDefault .StylisticSet = wdStylisticSetDefault .ContextualAlternates = 0 End With Selection.MoveDown Unit:=wdLine, Count:=5 With Selection.Font .Name = "+Títulos" .Size = 10 .Bold = False .Italic = False .Underline = wdUnderlineNone .UnderlineColor = wdColorAutomatic .StrikeThrough = False .DoubleStrikeThrough = False .Outline = False .Emboss = False .Shadow = False .Hidden = False .SmallCaps = False .AllCaps = True .Color = 5296274 .Engrave = False .Superscript = False .Subscript = False .Spacing = 0 .Scaling = 100 .Position = 0 .Kerning = 10 .Animation = wdAnimationNone .Ligatures = wdLigaturesNone .NumberSpacing = wdNumberSpacingDefault .NumberForm = wdNumberFormDefault .StylisticSet = wdStylisticSetDefault .ContextualAlternates = 0 End With ActiveDocument.Save ActiveWindow.Close no Excel na macro acima eu gravava uma alteração jogava em "Cole/Digite a macro criada para se repetir" e mandava executar, ai selecionava os arquivos que a macro iria rodar para fazer as alterações. existe esta possibilidade no Word? Obrigado!

o erro estava na biblioteca mesmo que tinha se perdido. Muito Obrigado!

tenho uma rotina que rodo no autocad 2013, porém depois de atualizar para o 2018 e o Excel para 2016 esta rotina parou de funcionar, alguém sabe o porque? segue abaixo a rotina antiga usada. Sub DesenhoOrdenada() Dim returnObj As AcadObject Dim basePnt As Variant Dim LineObj As AcadLine Dim startpoint(0 To 2) As Double Dim endpoint(0 To 2) As Double 'inicializa os objetos do excel Dim excelApp As Excel.Application Dim wbkObj As Workbook Dim shtObj As Worksheet Set excelApp = GetObject(, "excel.application") Set shtObj = excelApp.ActiveSheet Dim linha As Integer On Error Resume Next linha = 12 While shtObj.Cells(linha, 1) <> "" Or shtObj.Cells(linha + 1, 1) <> If shtObj.Cells(linha, 1) <> "" Then startpoint(0) = endpoint(0) startpoint(1) = endpoint(1) startpoint(2) = endpoint(2) endpoint(0) = shtObj.Cells(linha, 1).Value endpoint(1) = shtObj.Cells(linha, 20).Value / 100 endpoint(2) = 0 If startpoint(0) = Null Then startpoint(0) = endpoint(0) startpoint(0) = endpoint(0) startpoint(0) = endpoint(0) Else Set LineObj = ThisDrawing.ModelSpace.AddLine(startpoint, endpoint) End If End If linha = linha + 1 Wend End Sub