Komprimace obrazku
Napsal: 02 kvě 2013 12:45
Dobrý den,
mám toto makro pro nahrání fotky do sešitu . Potřeboval bych nastavit ,aby při uložení tohoto obrazku proběhla komprimace z cca 12 MB na cca 400 Kb.
Nevím si rady děkuji všem za ochotu.
Private Sub foto_osobni_01_Click()
If (MsgBox("Chcete načíst novou fotku?", vbYesNo + vbDefaultButton2)) = vbNo Then Exit Sub
On Error Resume Next
Dim umisteni As String
umisteni = Application.GetSaveAsFilename("\\Filesrv\zlutysanon_vaclavak\foto\")
If umisteni <> "" Then
foto_osobni_01.Picture = LoadPicture(umisteni)
foto_osobni_01.PictureSizeMode = fmPictureSizeModeStretch
Sheets("Zakladaci karta").Foto_osobni_karta.Picture = LoadPicture(umisteni)
Sheets("Zakladaci karta").Foto_osobni_karta.PictureSizeMode = fmPictureSizeModeStretch
End If
End Sub
mám toto makro pro nahrání fotky do sešitu . Potřeboval bych nastavit ,aby při uložení tohoto obrazku proběhla komprimace z cca 12 MB na cca 400 Kb.
Nevím si rady děkuji všem za ochotu.
Private Sub foto_osobni_01_Click()
If (MsgBox("Chcete načíst novou fotku?", vbYesNo + vbDefaultButton2)) = vbNo Then Exit Sub
On Error Resume Next
Dim umisteni As String
umisteni = Application.GetSaveAsFilename("\\Filesrv\zlutysanon_vaclavak\foto\")
If umisteni <> "" Then
foto_osobni_01.Picture = LoadPicture(umisteni)
foto_osobni_01.PictureSizeMode = fmPictureSizeModeStretch
Sheets("Zakladaci karta").Foto_osobni_karta.Picture = LoadPicture(umisteni)
Sheets("Zakladaci karta").Foto_osobni_karta.PictureSizeMode = fmPictureSizeModeStretch
End If
End Sub