Diego1559
-
Posts
5 -
Cadastrado em
-
Última visita
Tipo de conteúdo
Artigos
Selos
Fabricantes
Livros
Cursos
Análises
Fórum
posts postados por Diego1559
-
-
2 minutos atrás, Joao531 disse:
@Diego1559 Tem que trocar de tela, pois eu acredito que seja problemas no cabo flat.
No caso, se eu comprar só o cabo flat da tela, e substituir, sanaria o problema? ou teria que trocar a tela toda?
-
Olá povo,
Recentemente a tela do meu notebook vem apresentando essas falhas durante o uso, tem a possibilidade de ser apenas um cabo flat ou outro tipo de defeito de fácil resolução e custo barato
-
2 horas atrás, Edson Luiz Branco disse:
Bem vindo ao fórum, @Diego1559
Provavelmente seu tópico ficou sem respostas até o momento por ter faltado anexar um modelo em Excel junto com sua dúvida.
Alterei seu código eliminando algumas partes e acrescentando outras. Teste em seu modelo e nos dê retorno, ok?:
Sub Carregar_Pares_Imagens() Dim Pict As Variant, ImgFileFormat As String, rgMescladas As Range, i As Long ImgFileFormat = "Image Files JPEG (*.jpeg),*.jpeg,Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp" Pict = Application.GetOpenFilename(ImgFileFormat, False, False, False, True) If IsArray(Pict) Then If UBound(Pict) > 6 Then MsgBox "Selecionar apenas 6 imagens" Exit Sub End If For i = 1 To UBound(Pict) Set rgMescladas = ActiveSheet.Cells(RowIndex:=Array(8, 29, 49)((i - 1) \ 2), _ ColumnIndex:=Array("A", "E")((i - 1) Mod 2)) If rgMescladas.MergeCells Then Set rgMescladas = rgMescladas.MergeArea rgMescladas.Worksheet.Shapes.AddPicture Filename:=Pict(i), _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Left:=rgMescladas.Left, _ Top:=rgMescladas.Top, _ Width:=rgMescladas.Width, _ Height:=rgMescladas.Height Next i End If End SubFicou da forma que preciso.Muito obrigado .Na próxima me atentarei pra anexar o excel
-
Olá pessoal,
Preciso da ajuda de vcs. Sou um curioso nesta área, e estou encontrando uma certa dificuldade para adaptar um código de VBA de uma planilha, para a planilha que uso.
Basicamente, no código que achei, ele insere 22 fotos sendo 3 por linha. Gostaria que ficassem apenas 2 por linha, conforme a foto da planilha que uso. E se possível, que elas se ajustassem automaticamente ao tamanho das células mescladas de cada espaço da Foto01, Foto02...Foto06. Já tentei modificar, porém, sempre fica uma foto para fora da minha planilha.
O código:
Sub Carregar_AutoImagens_Passagem_Serviço_Gocil()
Dim Pict
Dim ImgFileFormat As String
Dim Celula As String
Celula = "A95" ' celula que será inserido a imagem
ImgFileFormat = "Image Files JPEG (*.jpeg),*.jpeg,Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
'Pict = Application.GetOpenFilename(ImgFileFormat, False, False, MultiSelect:=True)
Pict = Application.GetOpenFilename(ImgFileFormat, False, False, False, True)
'If Pict = False Then End
If IsArray(Pict) Then 'IF ARRAY
If UBound(Pict) <= 22 Then 'IF I
j = 1
For i = LBound(Pict) To UBound(Pict) 'FOR I
Select Case i 'Cobertura de 22 imagens
Case 1 To 3
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "95"
Case 4 To 6
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "107"
End If
'IMAGEM: largura = 6 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "107"
Case 7 To 9
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "119"
End If
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "119"
Case 10 To 12
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "131"
End If
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "131"
Case 13 To 15
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "143"
End If
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "143"
Case 16 To 18
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "155"
End If
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "155"
Case 19 To 21
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "167"
End If
'IMAGEM: largura = 4 colunas; altura= 11 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "167"
End Select
Next i 'FOR I
Else 'IF I
MsgBox "Selecionar apenas 22 imagens"
End
End If 'IF I
End If 'IF ARRAY
End SubMinha tentativa em alterar o código para a minha planilha:
Sub Carregar_AutoImagens_Passagem_Serviço_Gocil()
Dim Pict
Dim ImgFileFormat As String
Dim Celula As String
Celula = "A8" ' celula que será inserido a imagem
ImgFileFormat = "Image Files JPEG (*.jpeg),*.jpeg,Image Files JPG (*.jpg),*.jpg, Image Files PNG (*.png),*.jpg, Image Files GIF (*.gif),*.gif, Image Files BMP (*.bmp),*.bmp"
'Pict = Application.GetOpenFilename(ImgFileFormat, False, False, MultiSelect:=True)
Pict = Application.GetOpenFilename(ImgFileFormat, False, False, False, True)
'If Pict = False Then End
If IsArray(Pict) Then 'IF ARRAY
If UBound(Pict) <= 6 Then 'IF I
j = 1
For i = LBound(Pict) To UBound(Pict) 'FOR I
Select Case i 'Cobertura de 6 imagens
Case 1 To 2
'IMAGEM: largura = 4 colunas; altura= 17 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "8"
Case 3 To 4
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "29"
End If
'IMAGEM: largura = 4 colunas; altura= 17 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "29"
Case 5 To 6
If Mid(Celula, 1, 1) = "M" Then
j = 1
Celula = Chr(64 + j) & "49"
End If
'IMAGEM: largura = 4 colunas; altura= 17 linhas
Application.ActiveSheet.Shapes.AddPicture Pict(i), False, True, Range(Celula).Left, _
Range(Celula).Top, Range(Celula).Width * 4, Range(Celula).Height * 11
j = j + 4
Celula = Chr(64 + j) & "49"
End Select
Next i 'FOR I
Else 'IF I
MsgBox "Selecionar apenas 6 imagens"
End
End If 'IF I
End If 'IF ARRAY
End Sub
.gif.2b4e357b60e9d38bb879125930add81c.gif)
.png.191ffedb3a62d3476a711704ba2a1d4c.png)
Sobre o Clube do Hardware
No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais
Direitos autorais
Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais
Artefatos intermitentes na tela do notebook
em Notebooks
Postado
Ta certo, obrigado pela atenção