salvar imagem automatico com qualquer usuario

[ad48]

pode me ajudar?
tenho este código abaixo funciona beleza no meu pc com meu usuário
quando outro usuário vai usar não roda em outro pc


ob: já tentei
ConferePasta = "C:\Users\Public\Desktop\ENVIO WHATSAPP"
no meu pc funciona, meu colega a pasta fica marcada somente leitura não consigo alterar.

Sub CRIAR_PASTA_DESKTOP()
Dim ConferePasta As String
'ConferePasta = "C:\NOVO1"
ConferePasta = "C:\Users\armando\Desktop\ENVIO WHATSAPP"
If Dir(ConferePasta, vbDirectory) = “” Then
MkDir ConferePasta
MsgBox "O diretório: " & ConferePasta & " FOI CRIADO! ARQUIVO SALVO SÓ FAZER O ENVIO", vbInformation, "AVISO"
End If
End Sub


Sub SALVAR_IMAGEM()
call CRIAR_PASTA_DESKTOP
Sheets("IMPRIMIR").Select
Dim rVis As Range, k As Long
For Each rVis In Range("A:A").SpecialCells(xlCellTypeVisible) '(PRIMEIRA COLUNA)
k = k + 1: If k = [A1] + 16 Then Exit For '[SOMA DE LIMHAS]+ TOTAL CABECALHO
Next rVis
Dim rgExp As Range: Set rgExp = Sheets("IMPRIMIR").Range("D4:U" & rVis.Row) '("SELEÇÃO DA AREA
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, TOP:=rgExp.TOP, _
Width:=rgExp.Width, Height:=rgExp.Height)
.Name = "ChartVolumeMetricsDevEXPORT"
.Activate
End With
ActiveChart.Paste
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\Users\armando\Desktop\Envio Whatsapp\" & [G12].Value & " " & [G1].Value & " Marcas ate dia " & [B1].Value & ".jpg"
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
Sheets("MENU").Select
Range("N6").Select
End Sub

[ad48]

Pasta e local quero salvar é "C:\Users\Public\Desktop\ENVIO WHATSAPP"
ex : "C:\Users\armando\Desktop\ENVIO WHATSAPP"" eu consigo rodar.
se enviar por e-mail para meus colegas
outros pc não tem meu usuario armando não funciona.

TESTE.rar

[ad48]

meu pc  local uso provisorio   "C:\Users\armando\Desktop\ENVIO WHATSAPP"

 

quero usar algo parecido  "C:\Users\Public\Desktop\ENVIO WHATSAPP"

ou outra forma que reconhece qualquer usuário em qualquer pc.

obrigado.

 

[CasaDoHardware]

Ja pensou em usar a unidade C do PC

 

É so criar um atalho para a pasta no Desktop

[ad48]

bom dia, CasaDoHardware

sim, tem como criar este atalho automático?

 

tenho colega um pouco atrapalhado quando fala em buscar em outro diretorio

por isto gostaria de colocar direto no Desktop.

adicionado 6 minutos depois

bom dia, Walter C. Catelan,

 

não rodou

[ad48]

  Em 17/03/2017 às 12:28, Walter C. Catelan disse:

Tira o C:\

É apenas o que eu digitei.

Expandir  

ok rodou beleza só não lacalizei a pasta.

[ad48]

  Em 17/03/2017 às 12:28, Walter C. Catelan disse:

Tira o C:\

É apenas o que eu digitei.

Expandir  

sim só não localizo ela

[ad48]

  Em 17/03/2017 às 14:47, Walter C. Catelan disse:

Se ele entro de novo no IF é porque não criou antes.

Expandir  

primeira vez sim, na segunda não entra novamente no IF, mas não localizo a pasta.

[ad48]

  Em 17/03/2017 às 16:55, Walter C. Catelan disse:

Ah, então ele criou sim, você é que não tá achando. Digite esse endereço no Iniciar -> Pesquisar

Expandir  

não sei o que acontece veja só