Ir para conteúdo
Fórum Script Brasil
  • 0

vba selecionar texto e colocar em tabela

crisreis

Perguntado por crisreis,

 Share

Pergunta

crisreis

crisreis

Postado
Postado

Caros programadores, teria como, usando VBA colocar estes texto na segunda coluna de uma tabela.

Cada texto deste tem uma imagem correspondente. A imagem eu consegui colocar na primeira coluna, mas o texto não.

Se puderem me ajudar agradeço.

Abaixo está o código que eu tento adaptar para minha necessidade.

Nome: Background.jpg

Tipo: Jpeg

Tamanho: 48.94 KB

Caminho: /private/var/mobile/Library/

----------------------------------

Nome: IMG_0001.THM

Tipo: Jpeg

Tamanho: 4.19 KB

Caminho: /private/var/mobile/Media/DCIM/100APPLE/

-----------------------------

Nome: IMG_0002.JPG

Tipo: Jpeg

Tamanho: 318.18 KB

MetaDados: EquipMake: Apple

EquipModel: iPhone

XResolution: 72.000000

YResolution: 72.000000

ResolutionUnit: 2

DateTime: 2009:07:07 12:27:58

GpsLatitudeRef: S

GpsLongitudeRef: W

GpsGpsTime: 12.000000 27.000000 29.840000

Caminho: /private/var/mobile/Media/DCIM/100APPLE/

------------------------------

Nome: P200010_13.30.jpg

Tipo: Jpeg

Tamanho: 1.09 MB

MetaDados: EquipMake: LG Electronics

EquipModel: KP570

SoftwareUsed: LGE_SW

Caminho: External/Pictures

------------------------

Nome: P060410_19.02.jpg

Tipo: Jpeg

Tamanho: 265.68 KB

MetaDados: EquipMake: LG Electronics

EquipModel: KP570

SoftwareUsed: LGE_SW

Caminho: External/Pictures

-----------------------

Nome: Z000410_12.28.jpg

Tipo: Jpeg

Tamanho: 1.11 MB

MetaDados: EquipMake: LG Electronics

EquipModel: KP570

SoftwareUsed: LGE_SW

Caminho: External/Pictures

-----------------

Sub macro1000()

    Dim j As Integer
    Dim i As Long
    Dim search As String
    Dim txt As String
    Dim para As paragraph

 Selection.WholeStory
 ActiveDocument.Content.ParagraphFormat.TabStops.ClearAll
 Selection.ClearFormatting

 'Format text

 With Selection.Font
' the Latin text font name and size.
        .Name = "Verdana"
  .Size = 10 ' Bold and Italic are the Font Style...
        .Bold = False
        .Italic = True
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
End With

'Format paragraphs.

 With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceAtLeast
        .LineSpacing = 12
        .Alignment = wdAlignParagraphLeft
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
    End With


‘Delete tabs.


 Dim oRng As Word.Range
 Set oRng = ActiveDocument.Range
 With oRng.Find
 .ClearFormatting
 .Text = "^t"
  While .Execute
 oRng.Delete
 Wend
 End With



'Resize pictures > 500 pixels.




Set DocThis = ActiveDocument
iILShapeCount = DocThis.InlineShapes.Count
For j = 1 To iILShapeCount
If PointsToPixels(DocThis.InlineShapes(j).Width, False) > 500 Then
ActiveDocument.InlineShapes(j).Height = _
ActiveDocument.InlineShapes(j).Height / 2
ActiveDocument.InlineShapes(j).Width = _
ActiveDocument.InlineShapes(j).Width / 2

End If

Next


‘Imagens - put border.

Set DocThis = ActiveDocument
iILShapeCount = DocThis.InlineShapes.Count
For k = 1 To iILShapeCount

  With Selection.InlineShapes(k)
  

        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth100pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth100pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth100pt
            .Color = wdColorAutomatic
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth100pt
            .Color = wdColorAutomatic
        End With
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth100pt
        .DefaultBorderColor = wdColorAutomatic
    End With


Next


'Delete data without interesting.

search = "Exif"

For i = ActiveDocument.Paragraphs.Count To 2 Step -1
ActiveDocument.Paragraphs(i).Range.Select

txt = ActiveDocument.Paragraphs(i).Range.Text
If InStr((txt), search) Then
ActiveDocument.Paragraphs(i).Range.Delete
End If
Next

search = "JPEG"

For i = ActiveDocument.Paragraphs.Count To 2 Step -1
ActiveDocument.Paragraphs(i).Range.Select

txt = ActiveDocument.Paragraphs(i).Range.Text
If InStr((txt), search) Then
ActiveDocument.Paragraphs(i).Range.Delete
End If
Next


search = "Image"

For i = ActiveDocument.Paragraphs.Count To 2 Step -1
ActiveDocument.Paragraphs(i).Range.Select

txt = ActiveDocument.Paragraphs(i).Range.Text
If InStr((txt), search) Then
ActiveDocument.Paragraphs(i).Range.Delete
End If
Next


search = "Orientation"

For i = ActiveDocument.Paragraphs.Count To 2 Step -1
ActiveDocument.Paragraphs(i).Range.Select

txt = ActiveDocument.Paragraphs(i).Range.Text
If InStr((txt), search) Then
ActiveDocument.Paragraphs(i).Range.Delete
End If
Next

'Put blank paragraphs and add a table and add a reference to section break (BP).


For i = ActiveDocument.Paragraphs.Count To 2 Step -1
ActiveDocument.Paragraphs(i).Range.Select
If ActiveDocument.Paragraphs(i).Range.Characters.Count = 1 Then
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:=2
Selection.Tables.Item(1).Cell(1, 1).Column.Width = 220
Selection.Tables.Item(1).Cell(1, 2).Column.Width = 220
Selection.Tables.Item(1).Cell(1, 1).Range.Text = "Imagem"
Selection.Tables.Item(1).Cell(1, 2).Range.Text = "Dados de Exif"




Selection.TypeText Text:=".BP "
Selection.TypeParagraph
End If
Next

‘Add section break

For Each para In ActiveDocument.Paragraphs
    If para.Range.Words.first = "." Then
        If para.Range.Words(2) = "BP " Then
         para.Range.InsertBreak Type:=wdSectionBreakContinuous
           para.Range.Words.first.Delete
           para.Range.Words.first.Delete
           para.Range.Delete
        End If
    End If
Next para



With ActiveDocument
.Sections.first.Range.Delete
End With

With ActiveDocument
.Sections.first.Range.Delete
End With

With ActiveDocument
.Sections.Last.Range.Delete
End With

With ActiveDocument.Sections.first.Range
.Collapse direction:=wdCollapseEnd
.InsertAfter "IMAGENS"
End With

‘Put imagens inside the table

 iShapeCount = DocThis.InlineShapes.Count
For i = 1 To iShapeCount
ActiveDocument.InlineShapes(i).Range.Select
With Selection
.Cut
DocThis.Tables(i).Cell(2, 1).Range.Paste
End With
Next i



End Sub

Link para o comentário
Compartilhar em outros sites

6 respostass a esta questão

Posts Recomendados

  • 0
crisreis

crisreis

Postado
  • Autor
Postado

Oi, Nelson, que satisfação que você tenha se interessado.

Neste meu caso, eu recebo o documento original no Word já com a imagem, e no Excel a imagem não

aparece, apenas o nome do arquivo, por isso, desde sempre, eu pensei

em trabalhar em cima de uma macro para o Word. Mas se der para ser no excel,

também resolve.

Obrigado pela atenção.

Link para o comentário
Compartilhar em outros sites
  • 0
Nelson S

Nelson S

Postado
Postado

Para entender melhor o teu problema seria possível disponibilizar arquivos em um servidor tipo 4shared ou sendspace? Ou enviar por e-mail?

Um arquivo referente ao que você recebe, com a imagem original.

E outro arquivo referente a como você quer que o arquivo fique.

Visualizando os arquivos dá para entender melhor.

Link para o comentário
Compartilhar em outros sites
  • 0
crisreis

crisreis

Postado
  • Autor
Postado

Oi, Nelson,

o link para o arquivo original é: http://www.4shared.com/document/ryo2K6lF/I...crostestes.html

Coloquei apenas 4 imagens, mas em geral estes relatórios têm mais de 20.

Se você puder rodar a macro que eu postei, dá para ter uma ideia do que eu desejo, pois a única coisa que falta é colocar o texto que

se refere à imagem ao lado dela, ou seja, na segunda coluna. O link para a versão final é: http://www.4shared.com/document/sFBRQnOq/r...orio_final.html

Obrigado pelo interesse

Cristina Reis

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,2k
    • Posts
      652k
×
×
  • Criar Novo...